Ну вот и последняя страница!

Спасибо за внимание.

Хотите вернуться к началу?

Посетите наш сайт http://zmeyka.ussr.to


h0002.htm

В.В.Фаронов

Турбо Паскаль 7.0 Практика программирования

Учебное пособие

Издательство «Нолидж» 1999


h0003.htm

Оглавление

От автора 7

Глава! Текстовый ввод—вывод в графическом режиме 9

1 1 Организация видеопамяти в графическом режиме 10

1 1 1 Адаптер CGA 10

1 1 2 Адаптеры EGA и VGA 11

1 2 Структура CHR — файлов для векторных шрифтов 19

1 3 Модуль пода.ержки текстового ввода — вывода F_GrText 24

131 Используемые шрифты и координаты 25

132 Драйверы текстовых устройств 31

133 Подпрограммы модуля F_GrText 33

134 Тестовая программа 40

Глава 2 Обработка ошибок периода исполнения программы 44

2 1 Механизм обработки исключительных ситуаций 44

22 Модуль P_Jump 48

221 Текст модуля F_Jump 49

222 Тестовая программа 51

Глава 3 Работа с диском на физическом уровне 54

3 1 Структура дисков ДОС 54

311 Принцип работы дисковых накопителей 54

312 Логическая структура дисков 56

3 2 Средства BIOS и ДОС для работы с диском 66

3 2 1 Прерывание BIOS $13 66

322 Поддержка дисков в ДОС 76

3 3 Модуль F_Disk для работы с диском на физическом уровне 83

331 Описание модуля 83

332 Тестовая программа 90

Глава 4 Работа с мышью 92

4 1 Взаимодействие с драйвером мыши 92

4 2 Модуль F_Mouse 100

421 Глобальные константы, типы и переменные 100

422 Инициация мыши 101

423 Координаты 102

424 Состояние кнопок 103

425 Окна 104

426 Форма указателя 105

427 Сохранение/восстановление состояния 106

428 Эмуляция клавиатуры 107

429 Обработка событий от мыши 108

4210 Тестовая программа 110

Глава 5 Доступ к отображаемой памяти 120

5 1 Что такое отображаемая память 120

5 2 функции драйвера отображаемой памяти 123

5 3 Мо,дуль F_EMS 134

531 Объекты модуля ... 136

5.3.2 Глобальные ссылки .... 148

533 Тестовая программа 151

Глава 6 Защита программ от компьютерных вирусов 158

b 1 Что такое компьютерные вирусы 158

Ь 2 Цикл функционирования вирусов 159

6 3 «В<1кцинация» программ 160

631 Заголовок исполняемых файлов 160

'1 3 2 Защита вновь создаваемых программ 163


h0004.htm

6.3.3. Модуль F_Anti........................................................................................................................ 165

6.4. Защита существующих ЕХЕ—файлов ....................................................................................... 167

6.4.1. Описание программ SetFag.pas и Pag.asm .................................................................... 169

6.4.2. Программа AntiVir................................................................................................................. 173

6.5. Некоторые рекомендации ........................................................................................................... 174

Глава 7. Защита программ от нелегального копирования................................................................ 175

7.1. Суть защиты..................................................................................................................................... 175

7.2. Анализ индивидуальных признаков среды............................................................................... 177

7.2.1. Проверка типа ПК и версии ДОС ...................................................................................... 177

7.2.2. Проверка даты изготовления и контрольной суммы ПЗУ........................................... 179

7.2.3. Проверка места расположения файла на диске.............................................................. 179

7.2.4. Проверка состава аппаратных средств.............................................................................. 180

7.2.5. Использование скрытых частей программы и особенностей физических носителей информации.................................................................................................................. 187

7.3. Защита программ от трассировки............................................................................................... 194

7.4. Модуль F_Prot мя защиты программ........................................................................................ 199

7.4.1. Описание модуля..................................................................................................................... 199

7.4.2. Тестовая программа..............................................................................................................-.202

Глава 8. Pascal................................................................................................................................................. 204

8.1. Особенности среды ........................................................................................................................304

8.1.1. Отличия в меню....................................................................................................................... 204

8.1.2. Использование защищенного режима............................................................................... 205

8.1.3. Работа с браузером.................................................................................................................205

8.2. Особенности защищенного режима ......................................................................................... 206

9.2.1. Адресация памяти ...................................................................................................................207

9.2.2. Многозадачность..................................................................................................................... 208

9.2.3. Виртуальная память и перемещение сегментов.............................................................. 209

Глава 9. Программирование для защищенного режима...................................................................... 210

9.1 Расширитель ДОС............................................................................................................................210

9.2. Модуль WinAPI................................................................................................................................ 211

9.2.1. Управление памятью............................................................................................................. 213

9.2.2. Управление селекторами.......................................................................................................217

9.2.3. Управление модулями ............................................................................................................218

9.2.4. Управление ресурсами.......................................................................................................... 219

9.2.5. функции разного назначения.............................................................................................. 221

9.3. Работа с памятью ............................................................................................................................223

9.4. Создание и использование ресурсов .........................................................................................226

9.4.1. Создание ресурсов.................................................................................................................. 227

9.4.2. Использование ресурсов .......................................................................................................230

9.5. Создание и использование динамических библиотек..........................................................231

9.5.1. Создание DLL........................................................................................................................... 232

9.5.2. Использование DLL................................................................................................................. 235

Глава 10. Адаптация MS — DOS — программ к работе в среде Windows..........................................239

10.1. Введение в Windows..................................................................................................................... 239

10.2. Модуль WinCRT............................................................................................................................. 240

10.2.1. Переменные модуля WinCRT............................................................................................. 242

10.2.2. Процедуры и функции.........................................................................................................243

10.2.3. Модификация WinCrt для использования графики Windows................................... 244

Приложение. Тексты программ................................................................................................................ 248

П1. Модуль поддержки текстового вывода P_Text........................................................................ 248

П2. Модуль подй.ержки текстового ввода/вывода в графическом режиме F_GrText......... 271

ПЗ. Редактор векторных шрифтов..................................................................................................... 291

П3.1. Интерфейс с пользователем................................................................................................. 291

П3.2. Описание программы............................................................................................................ 294

П4. Модуль F_Disk д\я работы с диском на физическом уровне............................................ 314

П5. Модуль F^Mouse для работы с мышью ....................................................................................330

П6. Модуль F_Ems мя работы с отображаемой памятью........................................................... 345


h0005.htm

П7. Модуль P_Anti для защиты программ от вирусов..................................................................368

П8. Комплекс программ SetFag.pas/Fag. asm....................................................................................373

П8.1. Установщик фага SetFag.pas................................................................................................. 373

П8.2. Фаг Fag.asm............................................................................................................................... 380

П9. Программа AntIVir.......................................................................................................................... 388

П9.1. Текст программы AntiVir....................................................................................................... 388

П9.2. Программа восстановления структуры ЖД Set$v$.pas................................................. 413

П10. Модуль F_Prot для защиты программ от нелегального копирования.............................. 415

П10.1. Программа Diskette для подготовки ключевой дискеты.............................................. 415

П10.2. Модуль F_Prot....................................................................................................................418

Литература................................................................................................................................................. 428


h0007.htm

От автора

Эта книга задумана как практическое руководство по программированию разнообразных технических средств современного персонального компьютера (ПК) и рассчитана в основном на непрофессиональных программистов, знакомых с Турбо Паскалем' и использующих его для разработки программ, работающих под управлением операционной системы MS-DOS2. Она состоит из ряда глав, которые могут изучаться независимо друг от друга. Каждая глава посвящена определенной теме и построена по единому сценарию: в начале главы обсуждаются технические детали управления тем или иным устройством ПК, затем описываются разработанные автором и предназначенные для управления этим устройством программные средстваг а в заключение приводится соответствующая тестовая программа.

В последнее время появилась серия книг и журнальных публикаций, в которых обсуждаются те или иные вопросы профессионального доступа к аппаратным средствам ПК и программным возможностям MS-DOS, однако они носят в основном фрагментарный характер и рассчитаны на программистов, работающих с языком Си или ассемблером. В книге приводятся обширные тексты3 программных модулей, решающих эти задачи и реализованных целиком с помощью средств Турбо Паскаля. Вы можете использовать их в своих программах без какой-либо переделки, не вникая в детали доступа к тем или иным устройствам. Однако наиболее важным, с моей точки зрения, является то обстоятельство, что в книге описывается как можно решить проблему и почему выбран тот или иной способ ее решения. Для вдумчивого читателя, привыкшего критически относится к предлагаемым рецептам, это открывает широкие возможности совершенствования программных решений, которые отнюдь не претендуют на роль истины в последней инстанции.

В первой главе рассматриваются вопросы поддержки текстового ввода/вывода для программ, использующих графический режим работы видеоплат ПК. Проблема связана с тем, что стандартная библиотека Graph не имеет необходимых средств ввода текстовой информации, а входящие в ее состав векторные шрифты не поддерживают кириллицу. В главе последовательно описываются детали программирования видеоплат, конструирования собственных текстовых драйверов и внутренней реализации векторных шрифтов, позволяющие предельно упростить текстовый ввод/вывод в графическом режиме и реализовать его средствами стандартных процедур WriteLn и ReadLn. В ней описывается также редактор векторных шрифтов, с помощью которого Вы сможете при желании ввести в стандартные BGI— шрифты символы русского алфавита (кириллицы).

1 Турбо Паскаль — система программирования Гш-Ьо Pascal™ корпорации Borland® International Inc.

2 MS-DOS: Microsoft Disk Operating System — дисковая операционная система (ДОС) корпорации Microsoft® Corporation.

3 Исходные тексты описываемых в книге программ Вы можете найти на дискете, распространяемой издательством «Нолидж».


h0008.htm

Вторая глава посвящена устранению последствий исключительных ситуаций, связанных с фатальными ошибками периода исполнения программ (деление на ноль, нарушение формата вводимых данных, отсутствие требуемых аппаратных средств и т.п.). Обычно такого рода ошибки приводят к аварийному завершению работы программы.

В третьей главе рассматриваются средства, позволяющие обратиться к физическому диску как таковому, игнорируя, если это необходимо, его логическую организацию. Необходимость в этом возникает при создании программных средств для борьбы с компьютерными вирусами и нелегальным копированием, которым посвящены две другие главы книги (шестая и седьмая).

Ни в Турбо Паскале, ни в MS-DOS нет средств для работы с графическим указателем типа «мышь». В четвертой главе описываются возможности драйвера мыши корпорации Microsoft, которые стали фактическим индустриальным стандартом и поддерживаются практически всеми производителями программно—аппаратных средств. Приводимый в книге модуль F_Mouse основывается на средствах этого драйвера и упрощает использование мыши в текстовых и графических программах.

Если Вы пытались реализовать программы, требующие значительных ресурсов памяти, Вы наверняка столкнулись с пресловутым «барьером 640 Кбайт».' Современные ПК имеют 4 Мбайт и более оперативной памяти, но ни в MS-DOS, ни в Турбо Паскале нет средств работы с памятью, лежащей выше первых 640 Кбайт. В главах пятой и девятой описывается, как можно решить проблему доступа к «верхней» памяти: в первой из них показаны способы использования отображаемой EMS— памяти, во второй — работа в защищенном режиме с дополнительной XMS— памятью.

Три заключительные главы книги смогут представить для Вас интерес только в том случае, если Вы используете среду программирования ВР.ЕХЕ, входящую в Borland Pascal with Objects'™ 7.0. В этих главах описываются особенности программирования для защищенного режима процессора, использование ресурсов и DLL—библиотек, построенных по формату Windows, а также способы адаптации MS—DOS—программ к работе под управлением этой операционной системы. Насколько мне известно, эти проблемы так и не нашли должного отражения в отечественной литерату — ре.

4 ноября 1996 г.


h0009.htm

Глава 1

ТЕКСТОВЫЙ ВВОД-ВЫВОД В ГРАФИЧЕСКОМ РЕЖИМЕ

При разработке многих практически важных программ, таких как САПР, электронные таблицы, базы данных, бывает необходимо вывести на экран графики с поясняющим текстовым материалом. К сожалению, в текстовом режиме работы экрана практически невозможно построить более или менее сложные графики, а в графическом режиме Турбо Паскаль не обладает столь же простыми и мощными возможности текстового вывода, которые предоставляют процедуры Write/ WriteLn и Read/'ReadLn для текстового режима. Точнее говоря, использование этих процедур в графическом режиме вызывает определенные трудности: выводимый на экран текст имеет строго определенное начертание (шрифт) и на цветных экранах всегда выводится серым цветом, а отсутствие привычного мигающего курсора затрудняет ввод данных.

Специальные процедуры вывода- текстовых сообщений OutText и OutTextXY могут создавать великолепные по качеству текстовые вставки, но разработанные фирмой Borland стандартные векторные шрифты не содержат символов кириллицы, поэтому в подавляющем большинстве случаев приходится использовать матричный шрифт DefaultFont с гораздо более скромными возможностями.

В этой главе описываются подпрограммы модуля F_GrText, в котором в существенной мере устранены указанные недостатки. В главе анализируется структура векторных шрифтов, удовлетворяющих стандарту BGI (от Borland Graphics Interface — графический интерфейс фирмы Borland). На основе этого анализа Вы можете создать и использовать свои собственные векторные шрифты. Для облегчения этой задачи в прил.ПЗ приводится текст графического редактора шрифтов, а в состав модуля включена процедура OutString, позволяющая выводить сообщения любым векторным шрифтом с любыми пропорциями и под любым углом наклона к координатным осям экрана.

Остальные подпрограммы модуля с помощью графических средств обеспечивают достаточно полную имитацию текстового режима для ввода/вывода данных. Все они рассчитаны на использование наиболее популярных графических адаптеров CGA, EGA и VGA. Для увеличения скорости работы процедур ввода/вывода в них используется прямой доступ к графической видеопамяти, поэтому я начну главу с обсуждения организации видеопамяти и доступа к ней.


h0010.htm

10 Глава 1

1.1. ОРГАНИЗАЦИЯ ВИДЕОПАМЯТИ В ГРАФИЧЕСКОМ РЕЖИМЕ

1.1.1. Адаптер CGA

Адаптер CGA в графическом режиме использует те же 16 Кбайт видеопамяти (и по тому же адресу $В800:$0000), что и в текстовом режиме. Это дает возможность реализовать на экране лишь 320х200 пиксел с четырьмя возможными цветами в режиме низкого разрешения и 640х200 пиксел с двумя цветами в режиме высокого разрешения. Связано это со способом использования видеопамяти: в графическом режиме низкого разрешения каждый пиксел отображается в видеопамяти двумя битами (разрядами), а в режиме высокого разрешения — одним битом. Два бита дают возможность закодировать один из четырех возможных цветов, в то время как один бит — лишь два цвета. Так как нулевое значение бита (или пары бит для низкого разрешения) отождествляется с отсутствием светимости пиксела, т.е. с черным цветом, фактически для CGA—адаптера доступны лишь 3 цвета в режиме низкого и один — в режиме высокого разрешения.

Видеопамять в адаптере CGA трактуется как одна длинная строка бит, причем первый бит (пара бит) кодирует пиксел, расположенный в левом верхнем углу экрана, второй бит (пара бит) — пиксел, расположенный справа от него и т.д.; 640—и бит (или 320—я пара бит для низкого разрешения) кодирует самый правый пиксел верхней строки развертки. Следующая строка развертки определяется битами, расположенными начиная с середины видеопамяти, т.е. начиная с адреса $В800:$2000. Эта схема сохраняется для всех остальных строк — четные строки (с номерами О, 2 и т.д.) определяются содержимым первой половины видеопамяти, в то время как нечетные берутся со смещением $2000 = 8192 байта от ее начала.

Таким образом, чтобы в режиме высокого разрешения изменить светимость пиксела с координатами X, У (О<=Х<=639, 0<=У<=199), нужно в байте по адресу

Мет[$В800:((Y div 2)*80 + ord(odd(Y))*$2000 + Х div 8)] изменить бит

7-Х mod 8

(бит 7 соответствует старшему разряду байта), а для режима низкого разрешения (0<=х<=319, О<=Г<=199) — пару бит

(7 - 2*(Х mod 4)) и (6 - 2*(X mod 4)) по адресу

Mem[$B8OO:((Y div 2)*80 + ord(odd(Y))*$2000 + X div 4)]

При непосредственном обращении к видеопамяти CGA—адаптера необходимо синхронизировать доступ к памяти (чтение или запись байта) с


h0011.htm

периодом строчной и/или кадровой развертки, в противном случае на экране могут появиться интерференционные помехи в виде «снега». Синхронизация осуществляется с помощью проверки байта состояния адаптера, получаемого из его регистра статуса (порт $3DA). Перед чтением/записью байта следует непрерывно читать содержимое этого порта до тех пор, пока нулевой или третий биты получаемого из него байта статуса не станут равны единице: О—и бит равен 1 в момент перехода луча раз— вертки к началу следующей строки (в это время луч погашен в течение примерно 7 мкс), а 3—й бит приобретает значение 1 в момент перехода луча к началу кадра (луч погашен в течение 4 мс). Для ПК минимальной производительности (процессор 8088 с частотой 4.77 мГц) 7 мкс достаточны для пересылки одного, а 4 мс — около 900 байт. Во всех случаях соответствующая часть программы реализуется с помощью встроенного ассемблера, а пересылка должна идти при закрытых прерываниях, чтобы исключить влияние таймера.

1.1.2. Адаптеры EGA и VGA

Совершенно по—другому осуществляется доступ к видеопамяти адаптеров EGA и VGA. В графическом режиме эта память (она начинается по адресу $АООО:$0000) разбивается на четыре так называемые битовые плоскости. Запись в один байт видеопамяти приводит к возможному изменению сразу четырех байт (по байту в каждой плоскости) и регулируется несколькими регистрами (см. рис. 1.1).

Рис.1.1. Схема записи в видеопамять адаптера EGA/VGA

Для целей поддержки текстового ввода/вывода в графическом режиме нам понадобится использовать непосредственную запись в видеопамять адаптеров EGA/VGA, поэтому рассмотрим эту проблему более подробно.


h0012.htm

Замечу, что программирование адаптера VGA в стандартном режиме (640х480, 16 цветов), устанавливаемом процедурой InitGraph с помощью автодетектирования, полностью аналогично программированию адаптера EGA.

Каждая битовая плоскость связана с аппаратным устройством, формирующим определенную цветовую составляющую RGB— монитора: первая плоскость — синюю составляющую, вторая — зеленую, третья — красную (четвертая плоскость определяет интенсивность цвета). Поэтому цвет любого пиксела определяется совокупным значением бит в одном и том же разряде всех четырех битовых плоскостей: старший бит первого байта определяет цвет самого левого верхнего пиксела, следующий разряд первого байта — цвет второго пиксела в первой строке и т.д. Например, чтобы первый слева—сверху пиксел светился ярким белым цветом (точнее, цветом с номером 15; фактическое значение цвета может изменяться с помощью процедуры переустановки палитры), все 4 битовые плоскости должны иметь единицу в старшем разряде первого байта, а чтобы этот пиксел не светился (светился цветом 0) — ноль; другие комбинации нулей и единиц в том же разряде обеспечивают остальные цвета пиксела.

Между данными, посылаемыми (получаемыми) центральным процессором (ЦП), и видеопамятью расположено 4 буферных регистра — по одному на каждую битовую плоскость. Если ЦП записывает данные в видеопамять, он фактически записывает их в буферные регистры, точно так же при чтении — получает данные из них. Допустим, что показанные на рисунке управляющие регистры (регистры маски и цвета) не влияют на обмен данными. Тогда при записи байта со значением 128 (или в двоичном представлении 10000000) по адресу $АООО:ОООО во все четыре буферных регистра будет помещена одна и та же цепочка бит lOOOOOOQi в результате чего самый левый пиксел в верхней строке будет светиться белым цветом, а семь расположенных справа от него пиксел будут погашены.

Чтобы изменить цвет первого пиксела, мы должны перед записью байта отключить тот или иной буферный регистр. Для этого используется четырехразрядный регистр цвета: если в одном из разрядов этого регистра имеется ноль, соответствующий буферный регистр защищен от изменения, а значит не будет меняться и связанная с ним битовая плоскость. Чтобы, например, зажечь первый пиксел синим цветом, мы должны предварительно поместить в регистр цвета число 1, тогда лишь одна первая плоскость при записи байта изменит свое значение, в то время как три других останутся без изменения.

Во многих случаях не требуется одновременно изменять все восемь пиксел, связанных с одним и тем же байтом данных. Регистр маски битов позволяет управлять содержимым нужного разряда всех четырех буферных регистров одновременно: если регистр маски имеет ноль в каком—либо разряде, соответствующий разряд буферных регистров будет защищен от изменения. Таким образом, чтобы изменить только один первый пиксел, мы должны поместить в регистр маски двоичное число 10000000 (128), в регистр цвета — код нужного цвета, а затем записать по адресу $АООО:ОООО любое число с единицей в старшем разряде. Замечу, что регистр маски лишь запрещает изменение нужного разряда (разрядов)


h0013.htm

буферных регистров; для того, чтобы остальные пикселы на самом деле не изменили свой цвет, нам нужно предварительно прочитать значение байта по адресу $АООО:ОООО — в результате буферные регистры будут заполнены правильными значениями, а если этого не сделать, они сохранят значения, оставшиеся от предыдущего обращения к видеопамяти, которое, возможно, было связано с другим адресом.

Фактически мы только что рассмотрели лишь простейшие возможности одного (нулевого) режима записи. В адаптерах EGA/VGA существуют три различных режима записи: 0, 1 и 2. Нужный режим устанавливается с помощью предварительного выбора регистра режима. Для этого в порт по адресу $ЗСЕ необходимо переслать число 5 — номер регистра режима записи. Затем в порт по адресу $3CF следует послать номер режима записи (О, 1 или 2). Разумеется, к этому моменту адаптер должен находиться в графическом режиме работы. Вот как, например, можно установить режим записи 2:

Uses Graph;

var

D,R: Integer;

begin

D := Detect;

InitGraph(D,R,''); {Устанавливаем графический режим} if GraphResultOgrOk then

halt; {Ошибка инициации} Port($3CE) := 5; {Номер регистра} Port($3CF) := 2; {Посылаем в него номер режима}

end.

Таким образом, для записи одного пиксела по адресу Х,У (отсчет от нуля) в режиме 0 необходимо:

• определить адрес видеобайта, содержащего нужный пиксел; для координат Х,У это будет байт по адресу Mem[$AOOO: (Y*80+X div 8)];

• установить в единицу бит (7-Х mod 8) в регистре маски битов и поместить нули во все остальные разряды, т.е. запретить изменение любых пиксел, кроме нужного; для этого в порт $ЗСЕ нужно поместить номер регистра маски битов 8, а в порт $3CF — сформированную маску битов;

• установить нужный цвет в регистр цвета; д^я этого в порт $ЗС4 нужно послать 2 — номер регистра цвета, а затем в порт $ЗС5 — код нужного цвета;

• заполнить буферные регистры; для этого нужно прочитать видеобайт из памяти по адресу Mem[$AOOO: (Y*80+X div 8) ];

• установить в единицу бит (7-Х mod 8) в прочитанном видеобайте и послать его в видеопамять (если запрещены изменения во всех разрядках, кроме нужного, можно послать любой байт, содержащий единицу в этом разряде).


h0014.htm

Следующая программа иллюстрирует описанный алгоритм. В ней выводится вертикальная белая линия в центре экрана, после чего программа ожидает нажатия на клавишу Enter.

Uses Graph;

var

d,r,e,x: Integer;

y: Word;

b,bb: Byte;

begin

d := Detect;

InitGraph(d,r,''); {Инициируем графику} e := GraphResult;

if eOgrOk then

WriteLn(GraphErrorMsg(e) ) {Ошибка инициации} else begin

x := succ(GetMaxX) div 2; {Середина экрана} b := x mod 8; {Смещение в байте} b := 128 shi b; {Маска для битов} Port[$3CE] := 5; {Выбираем регистр режима} Port[$3CF] := 0; {Режим записи 0} Port[$3CE] := 8; {Выбираем регистр маски} Port[$3CF] := b; {Маскируем биты} Port[$3C4] := 2; {Выбираем регистр цвета} Port[$3C5] := White; {Устанавливаем цвет} for у := 0 to GetMaxY do {Цикл по строкам} begin

bb := Mem[$AOOO:Y*80+X div 8]; {Заполняем регистры? Mem[$AOOO:Y*80+X div 8] := $FF {Выводим точку} end;

ReadLn;

CloseGraph end end.

До сих пор были рассмотрены лишь простейшие возможности режима записи 0. С помощью предварительных настроек трех других управляющих регистров можно получать самые разнообразные эффекты.

Регистр специальных эффектов управляет способом взаимодействия данных, передаваемых ЦП, с содержимым буферных регистров. Назначение разрядов этого регистра показано на рис. 1.2.

Количество циклических сдвигов определяет, на сколько разрядов вправо будут циклически сдвинуты данные перед тем, как они поступят в буферные регистры. При циклическом сдвиге данных выталкиваемые справа младшие разряды переносятся в старшие (левые) разряды байта. Код операции задает способ взаимодействия данных, передаваемых ЦП, с содержимым буферных регистров:


h0015.htm

Текстовый ввод/вывод в графическом режиме 15

Рис. 1.2. Назначение разрядов регистра спецэффектов

00 - данные из ЦП переносятся в видеопамять

без изменения (операцией MOV);

01 - используется операция AMD (логическое И);

10 - используется OR (логическое ИЛИ);

11 - используется XOR (исключающее ИЛИ).

Регистр специальных эффектов выбирается посылкой значения 3 в порт $ЗСЕ, после чего его значение устанавливается посылкой нужного байта в порт $3CF.

Регистры фонового цвета и разрешения установки совместно определяют те битовые плоскости, в которые будут помещены единицы в случае, если программа разрешила установку пиксела в регистре маски, но не зажигает пиксел (передает в этом разряде ноль). Если, например, оба регистра содержат единицы в младшем разряде, т.е. кодируют цвет 1 (синиц), то при записи байта в видеопамять во все разрешенные маской и установленные в единицу разряда байта будет помещен код цвета из регистра цвета, в то время как в разрешенные разряды с нулями — код фонового цвета 1. В результате зажигаемые пикселы будут выведены нужным цветом на синем фоне. Регистр фонового цвета выбирается посылкой 0 в порт $ЗСЕ, а регистр разрешения посылкой 1 в этот порт; в обоих случаях данные передаются в выбранный регистр посылкой байта в порт $3CF (в контроллере используются лишь младшие 4 разряда этого байта).

В режиме записи 1 реализуется специальный эффект, связанный с копированием произвольной части экрана на другое место. В этом режиме нужно просто читать байты видеопамяти по одному адресу и записывать их по другому. Содержимое регистров маски битов и цвета в режиме 1 игнорируется.

В следующей программе сначала создается окно в центре экрана, которое постепенно заполняется случайными линиями. После нажатия на любую клавишу окно смещается вверх и вправо. После еще одного нажатия любой клавиши программа завершает свою работу.

Uses Graph,CRT;

var


h0016.htm

d,r,e,x: Integer;

у: Word;

b: Byte;

c: Char;

begin

d := Detect;

InitGraph(d,r,''); (Инициируем графику} e := GraphResult;

if eogrdk then

WriteLn(GraphErrorMsg(e)) {Ошибка инициации} else begin

{Создаем окно и обводим его рамкой} Rectangle(20*8,GetMaxY div 3,60*8,2*GetMaxY div 3) ;

SetViewPort(20*8+1,GetMaxY div 3+1,

60*8-1,2*GetMaxY div 3-l,ClipOn);

{Заполняем окно случайными прямыми} while not KeyPressed do {Ждем нажатия клавиши} begin

SetColor(Random(16)); {Случайный цвет} Line(Random(GetMaxX), (и координаты} Random(GetMaxY), {линии} Random(GetMaxX),Random(GetMdxY)) end;

{Сбрасываем буфер клавиатуры и устанавливаем режим записи 1} while KeyPressed do с := Readkey;

Port[$3CE] := 5; {Выбираем регистр режима} Port[$3CF] := 1; {Режим записи 1} {Переносим окно вверх и вправо)

for Y := GetMaxY div 3 to 2*GetMaxY div 3 do{По строкам} for X := 20 to 60 do {По байтам} begin

b :=Mem[$AOOO:Y*8O+X];

Mem[$AOOO:(Y-40)*8O+X+15] := b end;

{Ждем нажатия любой клавиши} if ReadKey=#O then с := ReadKey;

CloseGraph end end.

В режиме записи 2 данные от ЦП поступают в буферные регистры через регистр цвета. Для записи необходимо сначала нужным образом сформировать регистр маски битов, разрешив изменение нужного пиксела (пиксел), а затем по соответствующему адресу видеопамяти передать код нужного цвета (предварительно прочитав из видеопамяти в буферные


h0017.htm

регистры). В этом режиме используются лишь четыре младших разряда байта данных.

Следующая программа вычерчивает горизонтальную линию в середине экрана, затем ожидает ввода любого целого числа в диапазоне О... 15. Это число трактуется как код требуемого цвета, и линия вычерчивается этим цветом еще раз. Ввод и вычерчивание продолжается до тех пор, пока не будет введено любое число больше 15.

Uses Graph;

var

d,r,e: Integer;

y,x: Word;

b: Byte;

const

Col: Byte = White;

begin

d := Detect;

InitGraph(d,r,''); {Инициируем графику} e := GraphResult;

if eOgrOk then

WriteLn(GraphErrorMsg(e)) (Ошибка инициации} else begin

Y := succ(GetMaxY) div 2;

Port[$3CE] := 5; {Регистр режима} Port[$3CF] := 2; {Режим записи 2} Port[$3CE] := 8; {Регистр маски} Port[$3CF] := $FF; {Разрешаем все биты} repeat {Цикл вывода линии/ввода цвета} for X:=0 to GetMaxX div 8 do {По байтам}

Mem[$AOOO:Y*80+X] := Col; {Задаем цвет} ReadLn(Col) {Вводим код цвета} until Col>15; {Повторяем для разрешенных цветов} CloseGraph end end.

Хотя в описываемом ниже модуле F_GrText и не используется чтение графического экрана, наш обзор возможностей адаптеров EGA/VGA был бы не полным, если бы мы не рассмотрели эту возможность.

Существуют два режима чтения. В режиме 0 читается байт из выбранной битовой плоскости. Чтобы с помощью этого режима получить цвет восьми пиксел, нужно последовательно прочитать все четыре битовые плоскости, а затем поразрядно объединить прочитанные данные. Замечу, что четырехкратное чтение необходимо и для получения цвета единственного пиксела, поэтому в целях ускорения работы программы следует по возможности обращаться к группе смежных пиксел. Для использования режима чтения 0 нужно выбрать регистр режимов, послав 5 в порт $ЗСЕ, а затем послать код режима 0 в порт $3CF. Как Вы, очевидно, заметили,


h0018.htm

числом 5 выбирается и регистр режимов записи. На самом деле этим кодом указывается регистр режимов, младшие 2 бита которого определяют режим записи, а третий разряд — режим чтения. Для выбора битовой плоскости нужно указать регистр карты, послав 4 в порт $ЗСЕ, а затем послать номер плоскости — число от 0 до 3 — в порт $3CF.

В следующей программе иллюстрируется техника использования режима чтения 0 и попутно — использование спецэффектов в режиме записи 0. Вначале программа в режиме записи 0 выводит байт со значением 128, указав на необходимость его сдвига на 7 разрядов вправо. В результате вместо самого левого пиксела будет зажжен белым цветом восьмой по счету пиксел верхней строки. Затем устанавливается красный фоновый цвет и выводится байт со значением 1. В результате седьмой по счету пиксел (сдвиг на 7 разрядов сохраняется!) станет белым, в то время как остальные пикселы — красными. В заключение программа четырежды читает видеопамять по одному и тому же адресу, каждый раз указывая очередной код битовой плоскости, и преобразует прочитанное в коды цветов первых восьми пиксел самой верхней строки. В результате на экран будет выведено:

444444 15 4

Uses Graph;

var

d,r,e: Integer;

k,j,c: Byte;

a: array [ 0..3] of Byte ;

begin

d := Detect;

InitGraph(d,r,'') ;

e := GraphResult;

if eOgrOk then

WriteLn(GraphErrorMsg(e))

else begin

Port[$3CE] := 5 {Регистр режима} Port[$3CF] := 0 {Режим записи 0} Port[$3CE] := 8 {Регистр маски} Port[$3CF] := $FF; {Разрешаем все биты} Port[$3C4] := 2 {Регистр цвета} Port[$3C5] := White; {Устанавливаем цвет} Port[$3CE] := 3 {Регистр спецэффектов} Port[$3CF] := 7 {Сместить на 1 пиксел вправо} Мет[$АООО:0] := 128; {Выводим пиксел со сдвигом} ReadLn; {Ждем нажатия Enter} Port[$3CE] := 0; {Регистр фонового цвета} Port[$3CF] := Red; {Красный фон} Port[$3CE] := 1; {Регистр разрешения установки} Port[$3CF] := $4; {Разрешить красный} Мет[$АООО:0] := 1; {Выводим пиксел со сдвигом}


h0019.htm

ReadLn;

for k := 0 to 3 do {Читаем 4 плоскости} begin

Port[$3CE] := 4; {Регистр карты} Port[$3CF] := k; {Номер плоскости} a[k] := Mem[$AOOO:0]{Читаем байт} end;

CloseGraph;

{Преобразуем 4 прочитанных байта в коды цветов 8 пиксел} for j := 0 to 7 do {Цикл по пикселам} begin

с :== 0; {Начальный цвет} for k := 0 to 3 do {Цикл по плоскостям} с := c+(a[k] shr (7-j) and 1) shi k;

Write(c:3) {Выводим код цвета} end;

WriteLn end end.

Режим чтения 1 задается посылкой кода 8 в регистр режимов (сначала 5 — в порт $ЗСЕ, затем 8 — в порт $3CF). В этом режиме осуществляется сканирование 8 пиксел экрана и выбор тех из них, которые имеют нужный цвет. Перед чтением байта нужно в регистр сравнения послать код цвета (2 в порт $ЗСЕ и код цвета в порт $3CF). Получаемый байт будет содержать единицы в тех разрядах, для которых битовые плоскости определяют тестируемый цвет, и нули — во всех остальных разрядах. Этот результат можно изменить, если настроить регистр игнорирования цвета:

по умолчанию этот регистр (он выбирается посылкой 7 в порт $ЗСЕ и устанавливается посылкой байта в порт $3CF) содержит цепочку бит 1111, что блокирует его вмешательство в процедуру сравнения; если установить другое значение регистра, битовые плоскости, для которых разряды регистра имеют значение 0, будут игнорироваться. Пусть, например, самый первый байт верхней строки имеет цвет 3 (бирюзовый), что соответствует такой цепочке бит для первого разряда битовых плоскостей: ООН; пусть также мы установили цвет 2 (зеленый) в регистр сравнения (код 0010);

поскольку при сравнении будет выявлено различие в младшем разряде обоих кодов, чтение по адресу $АООО:ОООО в режиме 1 вернет байт со значением 0 в старшем разряде, если регистр безразличия содержит 1111, и 1 — если 1110.

1.2. СТРУКТУРА CHR-ФАЙЛОВ ДЛЯ ВЕКТОРНЫХ ШРИФТОВ

В этом параграфе мы рассмотрим структуру CHR— файлов, т.е. файлов с расширением CHR, в которых поставляются векторные BGI— шрифты. Такие шрифты широко используются в различных программных продуктах фирмы Borland, в том числе — в компиляторах Турбо Паскаль, Турбо С,


h0020.htm

Borland С + +. Необходимость анализа очевидна — ведь стандартные шрифты фирмы Borland не содержат символов кириллицы, и поэтому отечественные программисты либо вообще отказываются от использования векторных шрифтов, либо переводят сообщения на английский язык, что, согласитесь, не всегда удобно. Познакомившись с несложными соглашениями, по которым конструируются CHR— файлы, Вы затем сможете создать собственную версию генератора (редактора) векторных шрифтов или воспользоваться программой, приводимой в прил.ПЗ, чтобы вставить в стандартные шрифты кириллицу. Существует профессиональный пакет Borland BGI Toolkit, в состав которого включен более мощный редактор FE.EXE.

Любой CHR—файл. состоит из пяти частей: заголовка, блока параметров, таблицы смещений, таблицы ширин, блока векторных команд. Структура файла показана в таблице 1.1.

Таблица 1.1 Структура CHR-файла

Название поля | Смещение | Размер поля | Содержимое
FontPileID | о | 4 | 'РК'#8#8
Copyright | 2 | 0...253 | Любое (кроме $1А)
CopyrightEnd | ? | 1 | $1А
HeaderOffset | CopyrightEnd +1 | 2 | HeaderSize
FontName | CopyrightEnd + 3 | 4 | Название шрифта
FontSize | CopyrightEnd + 7 | 2 | Длина загружаемой части шрифта
FontVersion | CopyrightEnd + 9 | 3 | 1
ParPrefix | ? (Обычно 128) | 1 | '+'
CharsCount | ParPrefix+1 | 2 | Количество символов в шрифте
Reservl | ParPrefix+3 | 1 | Не используется
FirstChar | ParPrefix + 4 | 1 | Код первого символа
DataOffset | ParPrefix + 5 | 2 | FontStart— ParPrefix
FillFlag | ParPrefix+7 | 1 | Флаг заполнения
UpperMargin | ParPrefix+8 | 1 | Верхняя граница символа
Reserv2 | ParPrefix+9 | 1 | Не используется
LowerMargin | ParPrefix+10 | 1 | Нижняя граница символа
Reserv3 | ParPrefix +11 | 5 | Не используется
Offsets | ParPrefix+16 | 2'[CharsCount] | Таблица смещений
Widths | ParPrefix+16+ 2'[CharsCount] | [CharsCount] | Таблица ширин
FirstData | ParPrefix+16+ 3'[CharsCount] | ? | Образы символов
FontEnd |  |  |

Поле FontFileID открывает любой CHR—файл и всегда содержит символы 'РК'#8#8, которые служат для определения корректности файла. Символы ' РК' — это инициалы Филиппа Кана (Philip Kahn) — основателя фирмы Borland. Два следующих за ними символа #8 («Забой») стирают эти инициалы при выводе содержимого файла на экран командой Type, поэтому на экране будет видна только последовательность символов из массива Copyright, в котором содержатся название шрифта и объявление авторских прав фирмы Borland. Д^ина массива Copyright в принципе


h0021.htm

может быть произвольной (во всех четырех стандартных шрифтах это г массив имеет одинаковую длину — 83 байта), т.к. он всегда заканчивается полем CopyrightEnd, содержащим символ #26 (#$1А) — конец файла.

Сразу за полем CopyrightEnd следует двухбайтное поле HeaderSize, содержащее длину заголовка в байтах плюс 1 (в стандартных шрифтах это поле имеет значение 128).

Поле FontName содержит четырехбуквенное название шрифта; это название передается процедуре InstallUserFont и должно совпадать с именем CHR— файла.

Двухбайтное поле FileSize содержит длину CHR— файла за вычетом длины заголовка, т.е. оно равно

FileSize(File)- HeaderSize.

Трехбайтное поле FontVersion в стандартных шрифтах содержит значения 1, 0, 1 и, по всей видимости, означает номер версии шрифта. При разработке собственных шрифтов лучше сохранить это поле таким же, как в стандартных шрифтах.

Остальная часть заголовка не имеет значения и может быть произвольной.

Поле ParPrefix отстоит на HeaderSize байт от начала файла (в стандартных шрифтах — на 128 байт). Оно открывает блок параметров шрифта и всегда содержит символ '+'. В поле CharsCount указывается общее количество символов, начертания которых определены в CHR— файле, а в FirstChar — код первого определенного символа. Совокупность полей CharsCount и FirstChar задают диапазон кодов символов; в стандартных шрифтах они обычно содержат значения 32 и 223, что означает, что эти шрифты определяют начертания ASCII— символов, начиная с #32 (Пробел) и до символа # 254 включительно.

Поле DataOffset содержит расстояние в байтах от поля ParPrefix до поля FirstData. Его значение определяется по формуле

DataOffset = 16+3*CharsCount,

в которой слагаемое 16 учитывает мину блока параметров, a Z'CharsCount — длину двух таблиц, следующих сразу за блоком параметров. Для стандартных шрифтов из файлов Trip, Goth и Litt это поле содержит

16 + 3*223 = 685

(для этих шрифтов CharsCount = 254-32+1 = 223).

Поле FillFlag содержит так называемый флаг заливки символов: если он сброшен (имеет нулевое значение), процедуры OutText и OutTextXY вы — водят только векторный «скелет» каждого символа, а при ненулевом значении заливают его текущим рисунком заполнения (устанавливается процедурой SetFillStyle). Поскольку контуры многих символов незамкнуты, заливка может разлиться по всему экрану, поэтому в стандартных шрифтах это поле всегда имеет значение 0.

Поле UpperMargin содержит максимальное, a LowerMargin — минимальное значение локальных координат для оси У. Локальные вертикальные координаты векторных команд могут иметь значения в диапазоне


h0022.htm

22 Глава 1

от —64 до +63 (см. ниже). Таким образом, эти поля определяют максимальный вертикальный размер любого символа: поле UpperMargin задает высоту от базовой линии до верхнего края самого высокого символа шрифта, а поле LowerMargin обычно содержит отрицательное значение типа Shortint, показывающее, насколько ниже базовой линии может располагаться нижний край любого символа.

Остальные поля блока параметров не используются и содержат нули.

Сразу за блоком параметров начинается таблица смещений Offsets. Эта таблица содержит CharsCount двухбайтных слов — по одному слову на каждый символ. В ней указывается, на каком расстоянии от поля FirstData содержится начало векторных команд каждого символа. Самый первый элемент таблицы всегда содержит 0. Разница в смещениях между соседними элементами определяет длину векторных команд для очередного символа, например, разница между вторым и первым элементами — длину командной последовательности (в байтах) для первого символа, между третьим и вторым — для второго элемента и т.д. Для последнего символа эта длина определяется разницей между полями FileSize и последним элементом таблицы. Если Вы не загружаете весь файл в память, Вам понадобится построить свою таблицу значений длин командных последовательностей, чтобы, по мере н_адобности, динамически подкачивать эти данные с диска, как это сделано в процедуре OutString модуля F_GrText [см. п.1.3.4).

Поле Widths длиной CharsCount байт содержит таблицу ширин, в которой указывается ширина (длина по оси X) каждого символа. Обычно каждый символ выравнивается влево относительно локальных координат, поэтому его ширина в таблице должна задавать также небольшое меж— символьное расстояние справа от него, чтобы символы не сливались друг с другом.

Поле FirstData определяет начало векторных команд, используемых для вычерчивания первого символа. Каждая векторная команда занимает одно двухбайтное слово и содержит локальные координаты и собственно команду (см. рис. 1.3).

Поскольку локальные координаты определены в диапазоне от —64 до +63, для "их представления используется 7 младших разрядов каждого байта, в то время как старшие разряды А и В определяют код команды (табл. 1.2).

Таблица 1.2 _________Векторные команды________

А | В | Команда
0 | о | Конец образа символа
1 | о | Не используется
о | 1 | Поднять «перо» и перевести его в точку Х,У
1 | 1 | Опустить «перо» и вести его до точки X,Y

Как правило, последовательность векторов начинается командой 01, по которой воображаемое «перо» в поднятом состоянии переводится к началу самого первого вычерчиваемого вектора. Заканчивается последователь—


h0023.htm

Текстовый ввод/вывод в графическом режиме 23

ность командой 00, в которой координаты Х и У игнорируются, поэтому обычно это — команда $0000. Непосредственно перед ней часто указывается команда Widths [N]+$80, что означает установку «пера» на горизонтальной оси на расстоянии ширины символа от начала координат. То положение, которое «перо» заняло в конце вычерчивания предыдущего символа, автоматически становится началом локальных координат для векторных команд следующего символа. Если не перевести перо в самый правый край предыдущего символа, следующий за ним символ может частично или полностью перекрыть предыдущий символ, а если при этом вертикальная координата не равна нулю, символы будут вычерчиваться «лесенкой».

а)

б)

Рис. 1.3. К определению векторных команд: а) структура команды;

б) вертикальные координаты символов

Координата Х определяет обычную декартовую координату по оси абсцисс и всегда имеет значение в диапазоне от 0 до Widths [N] (Widths [N] — ширина символа в таблице ширин). Координата У может задавать как положительные, так и отрицательные значения, поскольку нижняя кромка символа (поле LowerMargin} может располагаться ниже координаты У=0 («хвостики» у букв р, q, g и т.п.). Поэтому при опреде—


h0024.htm

лении координаты У используется следующее соглашение: если У<=63, координата используется так, как она задана в команде, в противном случае она определяется разницей У— 128.

В прил.П! приводится текст относительно несложной программы, с помощью которой Вы сможете разработать собственные векторные символы и включить их в стандартные CHR — файлы.

1.3. МОДУЛЬ ПОДДЕРЖКИ ТЕКСТОВОГО ВВОДА-ВЫВОДА F_GRTEXT

В описываемый ниже модуль F_GrText включено около 20 подпрограмм, большая часть которых имитирует обычный текстовый режим ввода/вывода для программ, работающих с графическим экраном. Используя эти подпрограммы, Вы сможете без особого труда перенести работу ранее созданных диалоговых программ, рассчитанных на стандартные процедуры ввода/вывода Read, ReadLn, Write и WriteLn, в графическую среду. После такого переноса программа сможет инициировать графический режим и работать внешне точно так же, как если бы она работала в текстовом режиме, однако теперь ей станут доступны все процедуры и функции стандартного модуля Graph. Иными словами, модуль позволяет объединить в рамках одной программы два режима одновременно — текстовый и графический.

В основе модуля лежит возможность создания и использования нестандартных драйверов текстовых устройств. Такая возможность связана с «перехватом» обращения процедур Write, WriteLn., Read и ReadLn к физическим устройствам — соответственно к дисплею и клавиатуре. После такого перехвата программа пользователя получает в свое распоряжение текстовую строку, подготовленную для вывода на экран процедурами Write/WriteLn, или может самостоятельно готовить текстовую строку, которая затем будет интерпретироваться стандартными процедурами Read/ReadLn.

С этой целью в исполняемую часть модуля включены функции Graph V/rite и GraphRead. Первая выводит на экран графическими средствами матричное изображение любого символа с учетом текущих атрибутов (цвета символов и цвета фона), а вторая реализует на графическом экране мигающий курсор и эхо—повтор вводимых символов точно так, как это делается в текстовом режиме. Более того, в модуле предусмотрена возможность динамического изменения матричных шрифтов, позволяющая программе менять фактическое разрешение текстового вывода и начертание надписей. Например, при работе с VGA—адаптером программа может использовать 25, 30, 34 или 60 строк по 80 символов в каждой в зависимости от загруженного матричного шрифта.

Поскольку в модуле программными средствами имитируются аппаратные возможности текстового вывода, этот вывод осуществляется значительно медленнее, чем в текстовом режиме, что, впрочем, не является существенным для многих приложений. Во всяком случае, возможность сочетать в рамках одного изображения текстовые и графические данные, на мой взгляд, с лихвой окупает этот недостаток.


h0025.htm

Для качественных надписей векторными шрифтами в состав модуля включены средства, с помощью которых Вы сможете выводить текст под любым утлом к координатным осям экрана.

Полный текст модуля см. в прил.П2.

1.3.1. Используемые шрифты и координаты

Прежде чем описывать подпрограммы модуля, следует подробнее рассмотреть используемый в них способ создания изображений символов. Подпрограммы получают адрес загруженного в память массива, содержащего поточечные образы каждого из 256 возможных символов. При необходимости вывода на экран соответствующая процедура отыскивает образ нужного символа и, руководствуясь им, последовательно, точка за точкой, рисует его на экране. Таким образом, непременным условием использования текстовых возможностей модуля является предварительная загрузка в память нужного шрифта. Техника разработки матричных шрифтов здесь не рассматривается, однако не пугайтесь: если Вас устраивает вывод, реализуемый в текстовом режиме на Вашем ПК, Вам не придется самостоятельно разрабатывать шрифт. Для его создания можно использовать следующую простую программу.

^————__———_——————————————————+

I Эта программа предназначена для создания \ ¦ поточечного шрифта, который может затем ¦

I использоваться в модуле F GrText \ +——————_————————————————————+;

Uses Graph,DOS,CRT;

type

ab = array [O..MaxInt] of Byte;

var

D,R,E: Integer;

P: "ab;

k,X,Y,B,H: Byte;

XO,YO: Integer;

F: File;

S: String;

Reg: registers;

begin

{Инициируем графический режим} D := Detect;

InitGraph(D,R,'') ;

E := GraphResult;

if EogrOk then begin WriteLn(GraphErrorMsg(E));

Halt end;

{Проверяем драйвер и назначаем высоту шрифта} case D of


h0026.htm

CGA: H := 8;

EGA: H := 14;

VGA: H := 16;

else

H := 8;

end;

fРезервируем нужную динамическую память и открываем файл с именем "BxH.fnt", где H - высота шрифта} GetMem(P,256*H) ;

Str(H,S);

s := '8x4-s+' .fnt';

Assign(F,S) ;

Rewrite(F,1) ;

{Определяем начальные координаты для эхо-повтора} ХО := 0;

YO := 20;

{Направляем текстовый вывод в верхний левый угол} GotoXY(l,l) ;

{Основной цикл создания побитовых образов символов} for k := 0 to 255 do begin

{Выводим очередной символ средствами прерывания $10, функция $А (вывод символа без атрибутов)} with Reg do begin

ah := $A;

al := k;

bh := 0;

ex : = 1 ;

Intr($lO,Reg) end;

{Сканируем созданное изображение слева-направо-сверху-вниз} for Y :» 0 to H-1 do begin

В := 0; {Начальное значение очередного байта} for Х := 0 to 7 do if GetPixel(X,Y)<>GetBkColor then begin

{Формируем байт шрифта} В := В or (128 shr X) ;

{Гасим символ в левом верхнем углу экрана} PutPixel(X,Y,GetBkColor) ;

{И повторяем его ниже} PutPixel(XO+X,YO+Y,White) end;

P'"[k*H+Y] := В {Запоминаем байт} end;

(Сдвигаем место эхо-повтора символов}


h0027.htm

inc(XO,10) , if XO>GetMaxX then begin

XO := 0;

inc(YO,20) end end;

{Записываем шрифт в файл и завершаем программу} BlockWrite(F,Р^,256*Н) ;

Close(F) ;

CloseGraph end.

В этой программе один из ключевых параметров — высота шрифта (переменная Н) определяется на основе анализа типа загруженного драйвера. В адаптерах CGA, EGA и VGA реализуется одинаковое разрешение по горизонтали в графическом режиме — 640 пиксел. Это определяет ширину поточечного образа каждого символа в 640/80 = 8 пиксел (для максимальной длины текстовой строки в 80 символов). Высота графического экрана, а следовательно, и высота образа символа различна: 200 строк развертки для CGA дают высоту символа в 200/25 = 8 пиксел для 25 текстовых строк, в то время как для EGA имеем 350/25 =14 пиксел, а для VGA — 480/25 = 19 пиксел. Адаптер VGA в текстовом режиме обеспечивает разрешение 720х400 пиксел, поэтому в нем используется шрифт размером 9х16. Однако поточечный образ каждого символа определяется матрицей 8х16 бит, так как в этом случае дополнительный 9—и пиксел по горизонтали автоматически выводится справа от символа цветом фона и служит для разделения символов друг от друга в строке.

После прогона приведенной выше программы в текущем каталоге будет сформирован двоичный файл, содержащий поточечные образы всех 256 символов. Эти образы используются при выводе сообщений в текстовом режиме, а значит Вы можете загрузить этот файл в память, чтобы рисовать символы графическими средствами.

Замечу, что для УСА—адаптера стандартный шрифт 8х16 обеспечивает 480/16 = 30 текстовых строк, т.е. вывод на экран этим шрифтом будет чуть мельче, чем в текстовом режиме. Если Вы хотите получить более точную имитацию текстового режима на VGA—адаптере, можно преобразовать создаваемый программой файл 8х16. fnt в файл 8x.l9.fnt. Увеличение высоты каждого образа до 19 пиксел обеспечит почти полную имитацию текстового вывода. Такое преобразование реализует следующая программа.

^——————————————————————————+

1 Эта программа служит для преобразования \ \ файла 8х16.fnt в файл 8х19. fnt I +---__------_------------------------------+^

Uses Graph;

type

tl6 = array [0..15] of Byte;


h0028.htm

28 Глава 1

tl9 = array [O..18] of Byte;

tl6_l = array [0..7,0..15,0..18] of Byte;

tl9_l = array [0..7,0..18,0..15] of Byte;

var

F16 File of tl6;

F19 File of tl9;

C16 tl6;

C19 tl9;

A16 tl6_l;

A19 tl9__l absolute al6;

X,Y,k,B,S: Byte;

D,R,E,XO,YO: Integer;

begin

{Инициируем графику} D := Detect;

InitGraph(D,R,' ') ;

E := GraphResult;

if EogrOk then begin

WriteLn(GraphErrorMsg(E)) ;

Halt end;

{Задаем начальные координаты эхоповтора} ХО := 0;

YO := 0;

{Открываем файлы} Assign(F16,'8xl6.fnt') ;

Reset(F16) ;

Assign (F19,'8xl9.fnt') ;

Rewrite(F19) ;

{Основной цикл преобразования} while not EOF(F16) do begin

Read(F16,C16); (Читаем очередной образ 8х16} {Сканируем его слева-направо-сверху-вниз в виде матрицы 8х16} for Y := 0 to 15 do for X := 0 to 7 do begin

{Выделяем нужный бит} B:=ord((C16[Y] and (128 shr X))<>0);

if BOO then

PutPixel(XO+X,YO+Y,White) ;

{Формируем 19 единиц или нулей} for k := 0 to 18 do

A16[X,Y,k] := В end;


h0029.htm

{Создаем изображение 8х19} for Y := 0 to 18 do begin

в := о;

for X := 0 to 7 do begin

S := 0; {Начальное значение суммы} for k := 0 to 15 do

S:=S+A19[X,Y,k]; {Суммируем веса} {Проверяем сумму} if (S>9) then

begin {Большинство клеток закрашено -

помещаем единицу и выводим пиксел} В := В or (128 shr X) ;

PutPixel(XO+9+X,YO+Y,White) end end;

C19[Y] := В end;

{Записываем сформированный образ в файл 8х19} Write(F19,C19) ;

{Сдвигаем эхо-повтор} inc(XO,20) ;

if X0>640 then begin

XO := 0;

inc(YO,20) end end;

{Завершаем программу} CloseGraph;

Close(F16) ;

Close(F19) end.

Программа считывает каждый образ шрифта 8х16 в переменную С 16, затем анализирует этот образ и формирует шрифт 8х19 в переменной С 19. Преобразование шрифта осуществляется методом весовых коэффициентов. Суть метода состоит в том, что каждый пиксел шрифта 8х16 разбивается в вертикальном направлении на 19 частей (переменная А16). Эти части заполняются единицами, если пиксел светится, или нулями — если не светится. После этого переменная А16 рассматривается как матрица 8х19, каждый элемент которой в вертикальном направлении разбит на 16 частей (переменная А19). Для этой переменной находится сумма всех элементов каждого пиксела (переменная 5). Если эта сумма больше 9, значит большая часть пиксела в шрифте 8х19 должна быть засвечена, и этот пиксел объявляется светящимся, если меньше — не светящимся. Рис. 1.4 иллюстрирует сказанное.


h0030.htm

30 Глава 1

Рас. 1.4. Пример преобразования символа шрифта 8х16 в шрифт 8х19

Как показывает практика, программа обеспечивает вполне приемлемое качество генерируемого шрифта 8х19.

Подпрограммы модуля F_GrText, имитирующие средства модуля CRT, имеют одинаковый с ними интерфейс. Важным отличием является то, что используемая в них координатная сетка текстового вывода определяется загруженным шрифтом. В связи с этим процедуры проверяют факт за— грузки шрифта и игнорируют вызов в том случае, если шрифт не загружен. Для загрузки шрифта программа пользователя должна разместить в памяти поточечные образы символов и вызвать процедуру регистрации шрифта SetFont. После выполнения этой процедуры координаты текстового ввода/вывода могут изменяться в диапазоне от 1 до MaxChar для горизонтальной оси и от 1 до MaxLine — для вертикальной. Параметры MaxChar и MaxLine определяются следующим образом:

MaxChar = (GetMaxX+1) div X MaxLine = (GetMaxY+1) div Y

где X — ширина, У — высота поточечных образов символов. Например, для VGA—адаптера при загрузке шрифта 8х8 параметр MaxLine получит значение 60, а для шрифта 8х19 — 25; в обоих случаях параметр MaxChar имеет значение 80. Это означает, что в первом случае программа работает с текстовым экраном 80х60 символов, а во втором — 80х25 символов. Левый верхний угол экрана имеет координаты (1,1).

С графическим экраном отождествляется текстовый курсор подобно тому, как такой курсор определяет место вывода данных в текстовом


h0031.htm

режиме. Текстовый курсор становится виден на графическом экране только при обращении к процедурам Read/ReadLn и сразу исчезает после окончания ввода. Текстовый курсор никак не связан с графическим курсором. Он изменяет свое положение после вывода очередного символа процедурами Write/ WriteLn или при исполнении процедуры GotoXY.

1.3.2. Драйверы текстовых устройств

Для упрощения текстового ввода/вывода в модуль F_GrText включен собственный драйвер текстовых устройств, позволяющий использовать стандартные процедуры Write/WriteLn и Read/RedaLn в графическом режиме. В этом разделе рассматриваются вопросы создания драйверой текстовых устройств.

С каждым текстовым файлом Турбо Паскаль связывает переменную типа Text, которая определена как запись следующего типа:

type

TextBuf = array [O..127] of Char;

TextRec = record

Handle Word; {Дескриптор файла}

Mode Word; {Режим использования файла}

BufSize Word; {Длина буфера}

Private Word; {He используется}

BufPos Word; {Индекс следующего символа в буфере}

BufEnd Word; {Количество необработанных символов}

BufPtr -^TextBuf; {Адрес буфера}

OpenFunc Pointer;

InOutFunc Pointer;

FlushFunc Pointer;

CloseFunc Pointer;

UserData array [1..16] of Byte;

Name array [0..'?9] of Char;

Buffer TextBuf end;

Поле Handle содержит дескриптор файла и используется при работе с дисковым файлом средствами ДОС.

Поле Mode может принимать одно из следующих значений:

const

fmClosed = $D7BO; {Файл закрыт} fmlnput = $D7B1; {Файл - в режиме чтения данных} fmOutput = $D7B2; {Файл - в режиме записи данных} fmInOut = $D7B3; {Файл - в режиме чтения/записи}

Любые другие значения этого поля означают, что файл не был открыт. Поле UserData никогда не используется Турбо Паскалем и зарезервировано для внутренних нужд вызывающей программы.


h0032.htm

32 Глава I

В поле Name содержится полный путь к файлу в формате ASCIIZ. В этом формате строка определяется как цепочка символов, заканчивающаяся символом #0.

Четыре поля типа Pointer в записи TextRec имеют следующий смысл:

• Open.Fu.nc — адрес функции, получающей управление при открытии текстового файла;

• CloseFunc — адрес функции, вызываемой при закрытии текстового файла;

• InOutFunc — адрес функции, активизируемой в момент физического обращения к устройству для записи или чтения информации;

• FlushFunc — адрес функции, осуществляющей «выталкивание»

текстового буфера при буферизованном выводе информации. Каждая из этих четырех функций должна транслироваться в расчете на дальнюю модель памяти и соответствовать следующему заголовку:

type

FuncType = Function (var F: TextRec): Integer;

Значение, возвращаемое функцией, зависит от успешности выполнения соответствующей операции и равно нулю, если операция прошла успешно.

Совокупность всех четырех функций определяет драйвер текстового устройства.

Назначение стандартным файлам Input и Output пользовательского драйвера заключается в установке соответствующих адресов в поля-указатели записей TextRec. Если Вы захотите назначить свой драйвер произвольному текстовому файлу, Вам понадобится разработать свою процедуру Assign. В ходе ее выполнения помимо установки адресов функций в поля—указатели, Вам нужно будет также обнулить имя файла, присвоив Name [0] := #0. Кроме того, в поле Mode необходимо поместить значение fmClosed, в BufSize — размер буфера, а в BufPtr — его адрес.

OpenFunc

Функция OpenFunc вызывается стандартными процедурами Reset, Rewrite и Append и предназначена для осуществления всех необходимых подготовительных действий для работы с конкретным файлом. Эта функция всегда вызывается первой, до вызова любой другой функции драйвера. Анализируя поле Mode, она может определить режим работы открытого файла и соответствующим образом установить значение поля InOutFunc, связав его с процедурой чтения или записи информации. Если функция вызывается из процедуры Append, т.е. файл открывается одновременно /ууя чтения и записи данных, поле Mode содержит значение fmInOut. В этом случае процедура должна изменить значение этого поля на fmOutput перед передачей управления в вызывающую программу.

InOutFunc

Функция InOutFunc вызывается стандартными процедурами Read, ReadLn, Write, WriteLn, EOF, EOLn, SeekEOF, SeekEOLn и Close.


h0033.htm

Если Mode = fmlnput, функция должна прочитать не более BufSize символов в буфер BufPtr и возвратить число фактически прочитанных символов в поле BufEnd. Кроме того, в поле BufPos функция должна поместить 0. Если функция возвращает 0 в поле BufEnd, Турбо Паскаль рассматривает это как признак конца файла.

Если Mode = fmOutput, функция InOut должна вывести на устройство BufPos символов из буфера BufPtr и поместить 0 в поле BufPos.

FlushFunc

Функция FlushFunc вызывается в конце работы процедур Read, ReadLn, Write, WriteLn. Если Mode = fmlnput, функция должна поместить в поля BufPos и BufEnd значения 0. Если Mode = fmOutput, функция может «вытолкнуть» буфер, т.е. записать остаток буфера в файл. Если Flush ничего не делает, текст будет передаваться на устройство до тех пор, пока не заполнится буфер или пока не закроется файл.

CloseFunc

Функция CloseFunc вызывается стандартной функцией Close для физического завершения работы с файлом.

1.3.3. Подпрограммы модуля F_GrText

Все подпрограммы модуля F_GrText можно разделить на три части:

подпрограммы, имитирующие стандартные средства модуля CRT для графического режима (процедуры CIrScr, GotoXY, TextBackground, TextCoIor, Window, функции WhereX, WhereY), средства вывода текстовых сообщений векторными шрифтами под любым утлом к координатным осям экрана и с любыми пропорциями (процедура OutString и функция RegisterCHRFile) и вспомогательные подпрограммы. Чтобы подпрограммы модуля F_GrText не были перекрыты одноименными подпрограммами модуля CRT, необходимо объявлять модуль F_GrText в предложении Uses после модуля CRT.

Процедура CIrScr. Очищает текстовое окно или экран, т.е. "заполняет его цветом текстового фона. Заголовок:

Procedure CIrScr;

После выполнения процедуры курсор помещается в левый верхний угол окна.

Процедура Colors. Устанавливает атрибуты текстового вывода. Заголовок:

Procedure Colors(Text,Back: Byte);

Функция GetMaxChar. Возвращает максимальное количество символов в строке экрана. Заголовок:

Function GetMaxChar: Byte;


h0034.htm

Функция GetMaxLine. Возвращает максимальное количество строк на экране. Заголовок:

Function GetMaxLine: Byte;

Процедура GetWindGraphCop. Возвращает графические координаты текстового окна. Заголовок:

Procedure GetWindGraphCoo(var X1,Y1,X2,Y2: Integer);

При выходе из процедуры переменные XI...Y2 содержат графические координаты установленного в данный момент текстового окна (или экрана в целом, если окно не установлено). Координаты соответствуют внешнему периметру окна: XI — самый левый пиксел первого символа, Х2 — самый правый пиксел последнего символа, Y1 — самый верхний пиксел первой строки, Y2 — самый нижний пиксел последней строки.

Процедура GotoXY. Переводит текстовый курсор в нужное место экрана. Заголовок:

Procedure GotoXY(X,Y: Byte);

Здесь X, Y — новые координаты курсора.

Текстовые координаты X, У должны быть в пределах от 1 до MaxChar (MaxLine). Если новое положение курсора находится за границами активного в данный момент окна, вызов процедуры игнорируется.

Замечу, что текстовый курсор может перемещаться только в позицию, кратную ширине шрифта по горизонтали и высоте шрифта — по вертикали. Таким образом, нельзя поместить текстовый курсор в произвольное место графического экрана (например, в точку с графическими координатами 1,1). Обращение GotoXY(l,l) означает, как и в обычном текстовом выводе, позиционирование курсора в левый верхний угол окна (или экрана, если окно не установлено).

Функция GraphQooX. Возвращает горизонтальную графическую координату по заданной текстовой координате. Заголовок

Function GraphCooX(X: Byte): Integer;

Здесь X — заданная текстовая координата.

функция возвращает графическую координату левого края символа, который будет выводится в позицию X, или (—1), если к моменту обращения не загружен шрифт или Х выходит за границы активного текстового окна.

Функция GraphCooY. Возвращает вертикальную графическую координату по заданной текстовой координате (см. функцию GrapbCooX).

Процедура GraphWrj.teOn. Назначает стандартным файлам Input и Output новые драйверы (см. п. 1.4.2). Заголовок:

Procedure GraphWriteOn;


h0035.htm

Текстовый ввод/вывод в графическом режиме ЗА

После вызова GraphWriteOn стандартные процедуры Read/ReadLn и Write/ WriteLn будут использовать средства модуля F_GrText.

При вводе это означает эхоповтор вводимых символов в текстовом окне с учетом установленного цвета символов и фона. В этот момент на экране появляется текстовый курсор, а пользователю становятся доступны следующие средства редактирования ввода:

• забой символа слева от курсора клавишей Backspase;

• перевод курсора к началу строки ввода — клавиша Ноте;

• перевод в конец строки ввода — клавиша End;

• перевод на символ влево или вправо — клавишами смещения курсора;

• забой символа, на который показывает курсор — клавишей Delete (Del);

• переход к режиму замены или возврат к режиму вставки — клавишей Insert (Ins); признаком работы в режиме замены являются увеличенные размеры курсора.

Любой, ввод должен завершаться нажатием на Enter или Esc, При нажатии на Enter введенная строка копируется в буфер BufPtr', длина строки помещается в BufEnd, и на экране осуществляется перевод курсора в начало следующей строки. Замечу, что «пустой» ввод соответствует BufEnd=0, что интерпретируется процедурами Read и ReadLn как нажатие CtrI—Z (конец файла Input). Чтобы исключить аварийное завершение работы программы (а именно так реагирует Турбо Паскаль на этот символ), в случае «пустого» ввода в буфер помещается символ #32 («Пробел»). При завершении ввода по клавише Esc в BufPtr также помещается единственный символ «Пробел» и дополнительно глобальная переменная EscFlag в интерфейсной части модуля F_GrText получает значение True (при выходе по Enter она имеет значение False). Чтобы определить факт нажатия клавиши Esc, программа пользователя может проанализировать состояние переменной EscFlag.

При выводе символов процедура GraphWrite тестирует аппаратуру дисплея и осуществляет прямой доступ к видеопамяти, если используются адаптеры EGA или VGA. Как показывает практика, прямой доступ к памяти EGA/ VGA— адаптеров увеличивает скорость формирования символов на экране в 8...10 раз, в то время как для CGA— адаптера в случае стандартного шрифта 8х8 он не дает существенного выигрыша в скорости (и не используется в модуле). Вы можете запретить прямой доступ к видеопамяти EGA/VGA, если поместите в глобальную переменную AppHandle значение False (по умолчанию она имеет значение True).

Процедура GraphWriteOff. Восстанавливает стандартное назначение файлов Input и Output, т.е. ликвидирует действие процедуры GraphWtriteOn. Заголовок:

Procedure GraphWriteOff;

Процедура SetFont. Регистрирует загруженный матричный шрифг ддя последующего использования его в процедурах ввода/вывода. Заголовок.


h0036.htm

36 Глава 1

Procedure SetFont(var Font; X,Y: Byte);

Здесь Font — любая переменная, содержащая загруженный шрифт; Х — ширина символа в пикселах, У — высота символа.

Например, для загрузки шрифта из файла «8х16. fnt» можно использовать следующий фрагмент программы:

Uses Graph,F_GrText;

var

D,R: Integer;

F: File;

Font: Pointer;

begin {Инициируем графический режим}

D := Detect;

InitGraph(D,R,'') ;

{Открываем файл}

Assign(F,'8х16.fnt') ;

Reset(F,1) ;

{Резервируем динамическую память для размещения шрифта}

GetMem(Font,FileSize(F)) ;

{Считываем файл в память}

BlockReacKF^ont^FileSizefF) ) ;

Close(F) ;

{Регистрируем шрифт}

SetFont(Font,8,16) ;

{Назначаем нестандартные драйверы ввода/вывода}

GraphWriteOn;

В ходе выполнения процедуры осуществляется пересчет разрешения экрана для текстового ввода/вывода. С этой целью рассчитываются внутренние переменные MaxChar (максимальная длина текстовой строки на графическом экране) и MaxLine (максимальное количество текстовых строк). Для расчета используется графическое разрешение экрана, возвращаемое стандартными функциями GetMaxX и GetMaxY, поэтому перед обращением к процедуре должен быть инициирован графический режим работы адаптера. После выполнения процедуры отменяется ранее установленное текстовое окно (если, разумеется, оно было установлено с помощью процедуры Window), а курсор переводится в левый верхний угол экрана. Текущие цвета символов и фона не меняются.

Следует заметить, что п< раметр X, задающий горизонтальную ширину символов, используется только для определения MaxChar. При фактическом выводе на экран ширина любого символа считается равной 8 пикселам (т.е. предполагается, что поточечные образы символов описываются матрицами размером 8хН бит). Кроме того, если Вы установите Х не равным 8, это скажется на границах текстового окна и вводе символов, в то время как при выводе на EGA/VGA прямым доступом к памяти символы


h0037.htm

будут располагаться так, как если бы была объявлена ширина Х = 8. Если Вы хотите поэкспериментировать с X, установите AppHandle = False, чтобы отключить прямой доступ к видеопамяти адаптеров EGA/VGA.

Процедура SetWindow. Устанавливает окно, очищает его и обводит рамкой. Заголовок:

Procedure SetWindow (XI, Yl, X2, Y2, Border: Byte; Header:

String; Clip, Build, Play: Boolean);

Здесь XI...Y2 — текстовые координаты окна; Border — тип рамки (соответствует константам XXXXBorder модуля F_Textj; Header — заголовок окна; Clip — признак отсечки; параметр Build управляет «разворачиванием» окна, a Play задает звуковое сопровождение.

В верхней части окна (на строке Yl] выводится заголовок Header; если длина заголовка больше X2 —XI—2, его «лишние» символы отбрасываются;

если Header"'', заголовок не выводится. Для Clip=True границы вновь созданного окна будут соответствовать внутренней части прямоугольника XI...Y2 без учета рамки (т.е. Xl==Xl+l, Y1=Y1+\, Х2=Х2-1, У2=У2-1), чтобы возможный вывод текста в окно не испортил его рамку. Если Build=True, окно как бы «разворачивает» свои размеры, постепенно заполняя все его пространство. При этом, если Р1ау=Тгие, процесс «развертки» окна сопровождается звуковым сигналом.

Процедура Scrolling. Осуществляет прокрутку окна на заданное число строк вверх или вниз. Заголовок:

Procedure Scrolling(N: Integer);

Здесь N — количество строк, на которые сдвигается окно (при N<0 окно сдвигается вниз).

Если абсолютное значение N превосходит высоту окна или если N •= О, окно полностью очищается. После прокрутки положение курсора не меняется.

Процедура TextBackqround. Устанавливает цвет фона для символов. Заголовок:

Procedure TextBackground(Color: Byte);

В качестве параметра Color могут использоваться соответствующие константы цвета, определенные в модуле Graph. Замечу, что установка цвета фона с номером 0 означает, что символы будут накладываться на существующее изображение, т.е. выводиться так, чтобы не менялись пикселы фона. Вы можете использовать эту возможность для наложения поясняющей надписи на график. Установка любого другого цвета приведет к заполнению пиксел фона нужным цветом, т.е. вывод будет стареть существующее графическое изображение. Для цвета фона могут использоваться как темные, так и яркие тона.

Процедура SetColor. Устанавливает цвет символов. Заголовок:

Procedure SetColor (Color: Byte);


h0038.htm

Функция TextCooX. Возвращает ближайшую текстовую горизонтальную координату по заданной графической координате. Заголовок:

Function TextCooX(X: Integer): Byte;

Если заданная графическая координата выходит за горизонтальные границы окна, функция возвращает ноль.

Функция TextCooY. Возвращает ближайшую текстовую вертикальную координату по заданной графической координате. Заголовок:

Function TextCooY(Y: Integer): Byte;

Если заданная графическая координата выходит за вертикальные границы окна, функция возвращает ноль.

Функция WhereX. Возвращает текущее положение текстового курсора по горизонтали. Заголовок:

Function WhereX: Byte;

Возвращаемая координата определяется относительно границ окна (или экрана, если окно не установлено).

Функция WhereY. Возвращает текущее положение текстового курсора по вертикали. Заголовок:

Function WhereY: B^e,

Возвращаемая координата определяется относительно границ окна (или экрана, если окно не установлено).

Процедура Window. Устанавливает текстовое окно. Заголовок:

Procedure Window(XI,Y1,X2,Y2: Byte);

Здесь XI, Yl — текстовые координаты левого верхнего, а Х2, Y2 -правого нижнего углов окна. Координаты всегда определяются относительно границ всего окна.

Установленное на экране окно ведет себя точно так же, как и в текстовом режиме, за исключением автоматической прокрутки при выходе курсора за нижнюю границу окна. Вместо прокрутки вывод будет просто подавлен, если очередной символ должен выводиться за правый нижний угол окна.

Функция ReqisterCHRFile. Регистрирует векторный шрифт и возвращает его идентификационный номер для последующего использования в процедуре OutString. Заголовок:

Function RegisterCHRFile(FileName: String): Integer;

Здесь FileName — имя файла формата CHR, содержащего регистрируемый векторный шрифт.

Особенности структуры СИЛ—файлов пордробно рассмотрены выше (см. п.24.2). Регистрация шрифта заключается в проверке заголовка файла и считывании в память таблицы смещений и таблицы ширин. При ус—


h0039.htm

пешном завершении регистрации функция возвращает положительное число — идентификационный номер шрифта, который используется в качестве одного из параметров обращения к процедуре OutString. При обнаружении ненормальных ситуаций функция возвращает отрицательное значение, имеющее следующий смысл:

— 1 — ошибка доступа к файлу (файл нельзя открыть или обнаружена ошибка при чтении из него данных);

—2 — содержимое файла не соответствует формату BGI— шрифта (ошибка в заголовке файла или несоответствие мины файла параметрам шрифта);

—3 — нет памяти для размещения информации о шрифте (для регистрации одного шрифта требуется чуть больше 2 Кбайт динамической памяти).

Функция ReqisterCHRFont. Регистрирует векторный шрифт и возвращает его идентификационный номер для последующего использования в процедуре OutString. Заголовок:

Function RegisterCHRFont(Font: Pointer): Integer;

Здесь Font — адрес участка оперативной памяти, в который ранее был прочитан CHR—File.

Эта функция аналогична функции RegisterCHRFile за исключением того, что перед обращением к ней шрифтовый файл необходимо прочитать в оперативную память ПК. Использование этой функции вместо RegisterCHRFile дает два преимущества. Во-первых, заметно быстрее становится вывод процедурой OutString, так как исключаются обращения к диску для чтения векторных команд. Выигрыш в скорости особенно ощутим, если Вы используете CHR— файлы, расположенные на дискете. Во—вторых, Ваша программа может компилироваться со встроенными шрифтами подобно тому, как это реализовано в модуле Graph. Например, после преобразования файла Trip.Cbr командой

binobj trip.chr trip.obj trip можно использовать такую программу:

Uses Graph, F_GrText;

Procedure Trip; External;

{$L Trip.obj} var

d,r: Integer;

begin

d := Detect;

InitGraph(d,r,'') ;

MoveTo(0,100) ;

if RegisterCHRFont(@Trip)>O then {Шрифт зарегистрирован нормально} OutString('Нормальная регистрация',1,0,1,1) else

begin {Ошибка регистрации/


h0040.htm

SetTextStyle(TriplexFont,HorizDir,4) ;

OutText('Ошибка при регистрации шрифта') end;

ReadLn;

CloseGraph end.

Процедура OutStrincr. Выводит текстовую строку в текущую позицию графического экрана. Заголовок:

Procedure OutString(S: String; Font,Angle: Integer;

ScaleX,ScaleY: Real);

Здесь S — текстовая строка, которую требуется вывести на экран; Font — номер векторного шрифта (шрифт должен быть предварительно заре — гистрирован с помощью функции RegisterCHRFile или RegisterCHRFontj;

Angle — угол по отношению к горизонтальной координате экрана, на которую должен быть повернут выводимый текст (задается целым числом угловых градусов; положительные углы отсчитываются против часовой стрелки); ScaleX, ScaleY — масштабные коэффициенты соответственно по ширине шрифта и по его высоте.

Перед выводом процедура вначале определяет текущее положение графического указателя с помощью вызова GetX, GetY и считает это по — ложение точкой отсчета локальных координат первого выводимого симво — ла. После вывода очередного символа эта точка смещается в соответствии с векторными командами, а после завершения вывода всей строки графический указатель перемещается в конец последнего выведенного символа. Локальные координаты каждой векторной команды умножаются на масштабные коэффициенты ScaleX, ScaleY и затем пересчитываются с учетом требуемого угла поворота. Поскольку в процедуре интенсивно используются тригонометрические преобразования координат, вывод с ее помощью происходит заметно медленнее, чем в случае использования стандартных процедур OutText, OutTextXY. Для ускорения счета все тригонометрические преобразования осуществляются над данными типа Single, что примерно в 5...8 раз сокращает время вывода на ПК с арифметическими сопроцессорами.

1.3.4. Тестовая программа

В следующей программе иллюстрируется использование средств модуля F_GrText. Программа вначале выводит несколько раз одно и то же сообщение с помощью процедуры OutString. Для каждого символа сообщения устанавливается свой угол наклона, плавно меняющийся от 0 до 30 градусов и обратно (см. рис. 1,5).


h0041.htm

Текстовый ввод/вывод в графическом режиме 41

Рис. 1.5. Экран, создаваемый тестовой программой

Затем с помощью вызова SetWindow в верхней части экрана создается текстовое окно, в которое выводятся начальные строки PAS—файла с текстом программы. После нажатия на любую клавишу текстовое окно очищается и программа реализует ввод произвольной текстовой строки. После завершения ввода содержимое окна сдвигается вниз и программа ожидает нажатия на любую клавишу.

^+——---——————————————————————+

¦ Пример использования модуля F_GrText I +-__------_-----------------------------+^

Uses CRT,Graph,F_GrText;

const

DX = 50; {Ширина текстового окна} DY = 11; {Высота текстового окна} tl: String='Лучшая в мире система программирования';

t2: String='Турбо Паскаль ';

Grad = Pi/18O; {Перевод градус/радиан}

var

D,R,E: Integer;

Angle: Integer; {Угол поворота букв} xl,yl,x2,y2: Integer; {Координаты окон} F: File; {Файл со шрифтом} FT: Text; {Файл с текстом программы} N: Integer;

Р: Pointer; (Указатель на шрифт}


h0042.htm

S: String;

k,H: Byte;

C: Char;

begin

{Инициируем графику} D := Detect;

InitGraph(D,R, ' ') ;

E := GraphResult;

if EOgrOk then begin

WriteLn(GraphErrorMsg(E) ) ;

Halt end;

{Выводим текст процедурой OutString} if RegisterChrFile('trip.chr')>0 then begin

yl := succ(GetMaxY) div 20;

xl := 12*yl;

x2 := Length (tl) ;

y2 := GetMaxY-2*yl;

while xl<y2 do begin

MoveTo(O,xl) ;

for k := 1 to x2 do begin

Angle := Round(30*sin(grad*(k*360/x2)));

OutString(tl[k],1,Angle,0.9,1) ;

end;

inc(xl,yl) end;

MoveTo(2*GetMaxX div 7,GetMaxY-3*yl) ;

for k := 1 to Length(t2) do

OutString(t2[k],1,0,1,1) end;

{Выбираем нужный шрифт} case D of

CGA: H := 8;

EGA: H := 14;

VGA: H := 16;

else

H := 8;

end;

{Готовим имя файла, содержащего шрифт} Str(H,S) ;

S := '8х'+S+'.fnf; {Имя файла} {Открываем файл со шрифтом} Assign(F,S);


h0043.htm

Reset(F,1) ;

{Резервируем память и грузим шрифт} GetMem(P,FileSize(F) ) ;

BlockReacKF^^FileSizefF) ) ;

Close(F) ;

(Регистрируем шрифт и перехватываем ввод-вывод} SetFont(p,8,H) ;

GraphWriteOn;

{Создаем текстовое окно} TextColor(Black) ;

TextBackGround(White) ;

SetWindow ((GetMaxChar-DX) div 2,2,(GetMaxChar+DX) div 2,

(GetMaxLine+DY) div 3,DoubleBorder,

' Нажмите любую клавишу ',True,False,False);

{Открываем файл с текстом программы}

S := copy(ParamStr(0),1,pos('.',ParamStr(0)))+'pas';

Assign(FT,S) ;

Reset(FT) ;

(Читаем файл и выводим его в окно} for N := 1 to DY do

begin

ReadLn(FT,S) ;

WriteLn(S)

end;

Close(FT) ;

{Ждем действий пользователя} while not KeyPressed do;

while KeyPressed do

С := ReadKey;

{Очищаем текстовое окно и вводим строку} CIrScr;

WriteLn('Введите произвольный текст') ;

ReadLn(S) ;

{Сдвигаем ввод вниз окна и ждем} Scrolling(-DY div 2) ;

WriteLn('Текст смещен на ',-DY div 2,' строк');

WriteLn('Нажмите любую клавишу...');

С := ReadKey;

{Завершаем работу программы} GraphWriteOff;

CloseGraph end.


h0044.htm

Глава 2

ОБРАБОТКА ОШИБОК ПЕРИОДА ИСПОЛНЕНИЯ ПРОГРАММЫ

В стандартном языке Паскаль нет средств обработки так называемых исключительных ситуаций, т.е. ситуаций, связанных с возникновением той или иной ошибки в момент работы программы. В Турбо Паскале такие средства есть, но они не реализованы в виде стандартных подпрограмм. Отсутствие средств обработки исключительных ситуаций затрудняет создание различного рода диалоговых систем, в которых данные вводятся пользователем по запросам программы. В результате ошибки в подготовке данных в программах могут возникнуть некорректные ситуации типа деления на ноль или извлечения квадратного корня из отрицательного числа. Такие ситуации в программах на Турбо Паскале обрабатываются особой процедурой, которая дает краткое сообщение о характере и месте возникновения ошибки и аварийно завершает работу программы. В ряде случаев стандартное поведение программы требуется изменить, например сообщить пользователю о характере ошибки и вернуться в точку диалога, чтобы он мог ввести новые или отредактировать ранее введенные данные.

В этой главе обсуждаются средства, с помощью которых можно обрабатывать исключительные ситуации, и приводится текст модуля F_Jump, предназначенного для этих целей.

2.1. МЕХАНИЗМ ОБРАБОТКИ ИСКЛЮЧИТЕЛЬНЫХ СИТУАЦИЙ

Для обработки исключительных ситуаций в Турбо Паскале предусмотрены соответствующие средства: в стандартный модуль System включена переменная ExitProc, с помощью которой можно перехватить управление программой в момент возникновения исключительной ситуации. По умолчанию эта переменная (она имеет тип Pointer) хранит значение NIL; если поместить в нее адрес некоторой процедуры пользователя (назовем ее процедурой выхода), то при возникновении исключительной ситуации управление передается в эту процедуру. Процедура выхода должна быть процедурой без параметров. Ее следует транслировать в расчете на дальнюю модель памяти.

Проиллюстрируем сказанное на примере простейшей процедуры выхода. Пусть ее задачей является только расшифровка стандартного сообщения Турбо Паскаля. Это сообщение имеет вид

Runtime error nnn at xxxx:yyyy,

где nnn — код (номер) ошибкИг -хххх: уууу — адрес той инструкции в коде программы, при выполнении которой возникла исключительная ситуация. Код ошибки и адрес ее возникновения хранятся в переменных ExitCode и ErrorAddr модуля System. Если в момент завершения программы эти пе—


h0045.htm

ременные имеют значения соответственно 0 и NIL, никакого сообщения не выдается.

Создадим новый модуль с именем UsrE-xit, в интерфейсной части которого будет объявлена процедура UserExit. Эту процедуру может использовать любая программа для выдачи развернутой диагностики в момент аварийного завершения:

{=============} UNIT UsrExit; {=====^=========}

INTERFACE var

OldExit: Pointer; {Старое значение ExitProc} Procedure UserExit;

{Процедура выхода. Осуществляет печать диагностического

сообщения и завершает работу программы.} Function HexB(b: Byte): String;

{Перевод байта в 16-ричное представление} Function HexW(n: Word): String;

{Перевод слова в 16-ричное представление}

IMPLEMENTATION Procedure UserExit;

{Процедура выхода. Осуществляет печать диагностического

сообщения и завершает работу программы.} var

txt: String;

begin {UserExit}

ExitProc := OldExit; {Восстанавливаем работу

стандартной процедуры выхода}

WriteLn ('Ошибка при выполнении программы');

case ExitCode of

1: txt := 'Неверный номер функции';

2: txt := 'He найден файл';

3: txt := 'He найден путь';

4: txt := 'Слишком много открытых файлов';

5: txt ^ 'Отказано в доступе к файлу';

6: txt := 'Недопустимый файловый дескриптор';

12: txt := 'Недопустимый код доступа к файлу';

15: txt := 'Недопустимый номер дисковода';

16: txt := "Нельзя удалить текущий каталог';

17: txt := 'Нельзя указывать разные дисководы';

100: txt := 'Ошибка чтения с диска';

101: txt := 'Ошибка записи на диск';

102: txt := 'Файлу не присвоено имя';

103: txt := 'Файл не открыт';

104: txt := 'Файл не открыт для ввода';

105: txt := 'Файл не открыт для вывода';

106: txt := 'Неверный числовой формат';

150: txt := 'Диск защищен от записи';

151: txt :== 'Неизвестный модуль';


h0046.htm

152: txt := 'Не готов диск';

153: txt := 'Неопознанная команда';

154: txt := 'Ошибка в исходных данных';

155: txt := 'Неверная длина структуры';

156: txt := 'Ошибка установки головок на диске';

157: txt := 'Неизвестный тип носителя';

158: txt := 'He найден сектор';

159: txt := 'Кончилась бумага на принтере';

160: txt := 'Ошибка при записи на устройство';

161: txt := 'Ошибка при чтении с устройства';

162: txt := 'Сбой аппаратуры';

200: txt := 'Деление на ноль';

201: txt := 'Ошибка при проверке границ';

202: txt := 'Переполнение стека';

203: txt := 'Переполнение кучи';

204: txt := 'Недействительная операция с указателем';

205: txt := 'Переполнение при операции с пл.зпт.';

206: txt := 'Исчезновение порядка при операции '+ 'с плавающей запятой.';

207: txt := 'Недопустимая операция с плавающей запятой';

208: txt := 'He инициирован оверлей';

209: txt := 'Ошибка чтения оверлейного файла'

else txt := 'Ошибка N'+Str(ExitCode);

end; {case}

WriteLn(txt,' по адресу ',

HexW(seg(ErrorAddr^)),':',HexW(ofs(ErrorAddr"))) ;

ExitCode := 0;

ErrorAddr := NIL end; /UserExit} ^——————————————————J

Function HexB(b: Byte): String;

{Перевод байта в 16-ричное представление} const ^

HD: array [O..15] of Char = ('0','1','2','3','4','5','6', '7','8','9','A','B",'C','D','E','F');

begin {HexB}

HexB := HD[b shr 4]+HD[b and $F] end; {HexB} _•—__——_————————————_

Function HexW(n: Word): String;

{Перевод слова в 16-ричное представление} begin {HexW}

HexW := HexB(Hi(n))+HexB(Lo(n)) end; {HexW} end. {Unit UsrExit}

Обратите внимание: процедуру UserExit вовсе не обязательно объявлять дальней (с помощью зарезервированного слова Far), т.к. любая подпро—


h0047.htm

грамма, объявленная в интерфейсной части модуля, автоматически транслируется в расчете на дальнюю модель памяти.

В процедуре UserExit используется глобальная переменная OldExit. В нее программа пользователя должна поместить первоначальное значение переменной ExitProc, чтобы осуществились все необходимые стандартные действия, связанные с завершением работы программы. Для вывода адреса ошибочного оператора содержимое переменной ErrorAddr преобразуется в 16—ричный формат с помощью функции HexW. Такое преобразование может использоваться в программе пользователя и для других целей, поэтому функция HexW и вспомогательная функция НехВ также объявлены в интерфейсной части модуля.

Использование процедуры UserExit проиллюстрируем следующей

простой программой:

^———————————————————————————+

¦ Пример использования процедуры UserExit \

¦ для контроля работы программы \ -,-._——_——_—————.—,—————————————+_

Pses UsrExit;

var

x,y,z: real;

begin

OldExit := ExitProc; {Сохраняем старое значение ExitProc} ExitProc := @UserExit; {Указываем адрес процедуры UserExit} repeat

Write('X,Y= '); {Просим ввести операнды}

ReadLn(x,y); (Вводим операнды}

z := х/у; {Вычисляем их отношение}

WriteLn(z:15:7) {Выводим результат} until z=0;

ExitProc := OldExit {Готовим стандартное завершение} end.

В этой программе вводятся два произвольных вещественных числа и находится частное от деления первого на второе. Программа повторяет эти действия до тех пор, пока частное не станет равным нулю, или пока не возникнет исключительная ситуация. Последнее возможно в операторе

ReadLn(x,y),

если будет нарушен требуемый формат задания вещественных чисел (например, в записи числа будет указан недопустимый символ), или в операторе

z := х/у,

если делитель равен нулю.

Если Вы решите использовать подобную процедуру в Вашей программе, не забудьте восстановить стандартное значение NIL в переменной ExitProc перед завершением ее работы, в противном случае возможно «зависание» программы со всеми вытекающими отсюда последствиями.


h0048.htm

48 Глава 2

2.2. МОДУЛЬ F_Jump

Процедура UserExit не делает главного: она не предохраняет программу пользователя от аварийного завершения. Чтобы продолжить исполнение программы после обработки исключительной ситуации, нужно уметь передавать управление из процедуры выхода в нужную точку программы. На первый взгляд такие действия нетрудно реализовать с помощью оператора GOTO, однако вспомним, что все метки локализуются в той подпрограмме, где они описаны, причем никакая метка не может быть глобальной. Иными словами, в Турбо Паскале невозможно осуществить выход из процедуры оператором

GOTO <ВНЕШНЯЯ_МЕТКА>.

Для наших целей придется использовать возможности языка ассембле — ра. Учтем, что работа любой программы на уровне машинных команд управляется содержимым нескольких регистров центрального процессора. Для вычисления адреса очередной команды микропроцессор извлекает номер сегмента из регистра CS, а смещение — из регистра IP; для доступа к данным номер сегмента берется из регистра DS, а смещение — из ВХ или индексного регистра (5/ или DI); наконец, для доступа к программному стеку используется содержимое SS как сегмент стека, а содержимое одного из регистров—указателей [SP или ВР} — как смещение. Таким образом, для организации правильного выхода из процедуры завершения в нужную точку программы необходимо где-то запомнить содержимое этих регистров, которое соответствует корректному исполнению программы с нового места. На практике достаточно запомнить содержимое лишь четырех регистров — SP, ВР, CS и IP. Остальные регистры в ходе работы программы, написанной на Турбо Паскале, или не меняются, или автоматически обновляются.

Для запоминания указанных регистров используем переменные следующего типа:

type

JumpRec = record

SPsave, {Здесь сохраняется SP} BPsave: Word; {Здесь - регистр ВР} JmpPtr: Pointer {Здесь - CS и IP}

end;

В программе можно объявить сколько угодно переменных этого типа и связать их содержимое с различными точками выхода.

Общая схема управления программой, в которой осуществляется блокировка аварийного завершения, должна быть такой. Перед выполнением некоторого критического фрагмента программы, т.е. фрагмента, в котором может возникнуть исключительная ситуация, необходимо запомнить в переменной типа JumpRec нужную информацию (как это делается, мы обсудим ниже) и указать в переменной ExitProc адрес процедуры выхода. Если в ходе исполнения фрагмента возникнет исключительная ситуация, управление будет передано процедуре выхода, в конце которой следует


h0049.htm

восстановить содержимое сохраненных регистров. Сразу после того как в С5 и IP будет помещена необходимая информация, работа программы продолжится с нужного места.

Сохранение регистров SP и С5 не вызывает особых сложностей — в Турбо Паскале для доступа к ним предусмотрены стандартные функции SPtr и CSeg. Однако в стандартных библиотеках нет аналогичных функций для чтения регистров ВР и IP. Во всех случаях восстановление сохраненных значений регистров возможно только с помощью ассемблера (в дальнейшем д^я краткости я буду писать ассемблер вместо язык ассемблера).

Особые сложности связаны с сохранением текущего значения регистра IP, в котором содержится адрес (точнее, смещение) очередной машинной команды. Дело в том, что с адресом любого исполняемого оператора Турбо Паскаля может быть связана только метка, однако в Турбо Паскале не предусмотрено никаких операций над метками. В частности, невозможно получить связанный с меткой адрес. Таким образом, для определения адреса нужного оператора придется использовать единственно возможный путь: разместить ассемблерный фрагмент непосредственно перед этим оператором и вычислить расстояние в байтах от некоторого места внутри ассемблерной части до начала этого оператора.

Размещение ассемблерного фрагмента в теле программы не вызывает особых проблем — для этого в Вашем распоряжении имеются средства встроенного ассемблера и InLine— операторов. Отмечу, что в силу тривиальности ассемблерных частей их можно реализовать в виде макросов. Макрос представляет собой процедуру, тело которого заменяет один InL me— оператор. Такая конструкция рассматривается компилятором как готовая программная заготовка, снабженная собственным именем. Всюду, где в тексте программы встречается вызов макроса, компилятор автоматически вставляет нужные программные коды. Макросы могут иметь параметры, которые перед передачей управления помещаются в стек в соответствии с соглашениями Турбо Паскаля. Однако для вызова макроса не используется машинная инструкция CALL, как это обычно бывает при вызове подпрограммы, ведь тело макроса располагается сразу за предыдущим оператором Турбо Паскаля. По этой причине в конце макроса не следует указывать инструкцию RET. Во всем остальном макросы ничем не отличаются от других InLine— процедур.

2.2.1. Текст модуля F_Jump

Ниже приводится текст модуля F_Jump, в котором объявляется тип JumpRec и два макроса SetJump и LongJump. Макрос Setiump осуществляет необходимые действия по сохранению регистров, поэтому его необходимо размещать непосредственно перед тем оператором, на который требуется передать управление в случае возникновения исключительной ситуации. Макрос LongJump осуществляет обратные действия — восстанавливает сохраненные ранее регистры. В результате его работы управление будет передано в нужную точку программы, поэтому этот макрос следует размещать внутри процедуры выхода, непосредственно перед ее завершением.


h0050.htm

50 Глава 2

^=====—=======; UNIT F_Jump; {===='==========}

{

+----------------------------------------------------------+

I Модуль содержит макроопределения, позволяющие запомнить \ ¦ любую точку программы с тем, чтобы после обработки ошибки\ \ периода исполнения передать управление в эту точку. I

+_-------„--------------------------------------------------/-

;

INTERFACE type

JumpRec = record

SPsave, {Сохраняет регистр SP} BPsave: Word; {Сохраняет регистр DP} JmpPtr: Pointer (FAR-адрес продолжения}

end; {JumpRec} ^——,-.-.-————————;

Procedure Set Jump(var JumpDest: JumpRec);

{Этот макрос обеспечивает сохранение содержимого регистров SP, BP и IP в записи JumpDest. Запоминается состояние, которое имели регистры в момент вызова макроса. Это обеспечивает последующий возврат процедурой LongJump в точку, непосредственно следующую за вызовом.} InLine ( $5F/

{pop di ,'DI^Ofs(JumpDest) } $07/

{pop es ;ES=Seg(JumpDest) } S26/$89/$25/

{mov es:[di],sp ;помещаем SP в SPsave } $26/$89/$6D/$02/

{mov es:[d.i+2],bp /помещаем BP в BPsave } $E8/$00/$OO/

{call null /помещаем в стек текущий} {null: /адрес командой CALL} $58/

{pop ax ;АХ=текущий адрес } $05/$ОС/$ОО/

{add ax,12 ;смещение команды NEXT } $26/$89/$45/$04/

{mov es:[di+4],ax /сохраняем FAR-адрес } $26/$8C/$4D/$O6) ;

{mov es:[dl+6],cs ;команды NEXT в JmpPtr} {NEXT: ; эта инструкция идет сразу за макросом и связана

с началом очередного оператора Турбо Паскаля} _•———.—————————;

Procedure LongJump(var JumpDest: JumpRec);

{Этот макрос восстанавливает содержимое регистров SP и BP из полей SPsave, BPsavp записи JumpDest и делает


h0051.htm

FAR-переход по адресу JmpPtr.}

inline (

$5F/

{pop di ;DI=Ofs(JumpDest) } $07/

{pop es ;ES=Seg(JumpDest) } $26/$8B/$25/

{mov sp,es:[di] ;восстанавливаем SP } $26/$8B/$6D/$02/

{mov sp,es:[di+2] ;восстанавливаем ВР } $26/$FF/$6D/$04);

{jmp far es:[di+4] ; FAR-переход } IMPLEMENTATION

Макрос SetJump располагается непосредственно перед оператором, на который передается управление при возникновении исключительной ситуации. Так как для выполнения всех предусмотренных в макросе действий он должен получить управление, следующий за ним оператор Турбо Паскаля может выполняться дважды: первый раз при инициации процедуры выхода, т.е. до возникновения исключительной ситуации (и сразу после выполнения макроса SetJump), второй раз после ее возникновения (и сразу после выполнения макроса LongJump). Разумеется, второй проход оператора вовсе не обязателен — он будет осуществлен только при возникновении исключительной ситуации. Однако программист обязан помнить о своеобразной реентерабельности этой точки программы и предусмотреть в ней альтернативные действия. Таким образом, оператором, на который передается управление в исключительной ситуации, как правило, является условный оператор. В качестве условия, управляющего его работой, следует использовать какой—то признак, свидетельствующий о возникновении исключительной ситуации или о ее отсутствии. Этим признаком может быть логический флаг, устанавливаемый процедурой выхода, или содержимое стандартных переменных ExitCode и ErrorAddr (если, разумеется, процедура выхода не сбрасывает эти значения).

2.2.2. Тестовая программа

В следующей программе осуществляется ввод произвольного вещественного числа и находится частное от деления единицы на корень квадратный из этого числа. В программе возможно возникновение исключительной ситуации при вводе числа (ошибочный символ в записи вещественного числа), извлечении корня (число меньше нуля) и делении (делитель равен нулю). Все три критические точки запоминаются в переменной Jump, которая используется в исключительной ситуации. Программа повторяет описанные действия до тех пор, пока не будет введена единица.

_+———————---—————————————————————+


h0052.htm

Программа иллюстрирует механизм выхода из процедуры [

завершения в нужную точку программы. В программе \ осуществляется ввод произвольного целого числа, затем ¦

вычисляется корень квадратный из него и находится \ обратная ему величина. Для завершения работы программы \

следует ввести единицу. \ +————————————————————————-—————————+^

Uses F Jump;

var

OldExit: Pointer; {Старое значение переменной ExitProc} Jump : JumpRec; {Сохранение точки выхода} г : Real; {Вспомогательная переменная} label Loop;

Procedure MyExit; Far;

{Эта процедура обрабатывает исключительную ситуацию} begin

Long Jump(Jump) end; {MyExit} begin

OldExit := ExitProc;

repeat

Loop: {Точка повторения ввода} if ErrorAddr <> NIL then begin

Write('Повторите ввод числа: ');

ErrorAddr := NIL;

ExitCode := 0 end else

Write('Введите число: ');

ExitProc := @MyExit; /'Адрес процедуры выхода} SetJump(Jump); {Контролируем ввод данных} if ErrorAddr <> NIL then begin

WriteLn('Ошибка при вводе вещественного числа');

Goto Loop end else

ReadLn(r);

Set Jump(Jump); {Контролируем извлечение корня} if ErrorAddr <> NIL then begin

WriteLn('Ошибка при извлечении корня');

Goto Loop end else

r := sqrt(r);


h0053.htm

SetJump(Jump); {Контролируем деление} if ErrorAddr <> NIL then begin

WriteLn('Ошибка при делении чисел');

Goto Loop end else

r := 1/r;

WriteLn(r:20:10) until r = 1;

ExitProc := OldExit {Нормальный выход} end.

Как нетрудно заметить, процедура обработки исключительной ситуации MyExit в рассмотренном примере просто возвращает управление в нужную точку программы. Разумеется, в реальной программе ее можно сделать более сложной. Однако для большей «прозрачности» программы я рекомендую все дополнительные действия, связанные с обработкой исключительной ситуации, размещать в теле основной программы — ведь в критических точках обычно используются условные операторы вида

if ErrorAddr о NIL then ...

Отмечу одну особенность: непосредственно перед передачей управления в пользовательскую процедуру выхода Турбо Паскаль автоматически помещает в переменную ExitProc значение NIL. По этой причине оператор

ExitProc := SMyExit

помещен в тело цикла Repeat... Until. Если разместить его перед оператором Repeat, то после первой же ошибки программа перестанет обрабатывать исключительные ситуации, поэтому повторная ошибка приведет к аварийному завершению программы.

При использовании описанного средства обработки исключительных ситуаций в сложных программах с несколькими модулями следует учесть, что при передаче управления в подпрограмму другого модуля обычно изменяется значение сегмента кода. Если Вы использовали процедуру обработки ошибки в одном модуле, а ошибка возникла в процедуре из другого модуля, управление передается в процедуру обработки ошибки со значением сегмента кода, соответствующим модулю, в котором произошла ошибка. В результате процедура LongJump не сможет установить правильный NEAR— адрес переменной Jump и программа «зависнет». Чтобы этого не произошло, LongJump должна использовать FAR— адрес переменной Jump. Проще всего этого можно достичь, если поместить переменную Jump в интерфейсную часть любого модуля и использовать эту переменную для организации обработки исключительных ситуаций.


h0054.htm

Глава 3

РАБОТА С ДИСКОМ НА ФИЗИЧЕСКОМ УРОВНЕ

В Турбо Паскале есть довольно богатый набор подпрограмм, рассчитанных на работу с файлами и каталогами. Однако в некоторых нестандартных приложениях, таких как защита программ от компьютерных вирусов или нелегального копирования (см. главы 6 и 7), требуется обратиться не к файлу, а к диску как таковому, т.е. работать с диском на фи — зическом уровне (чтение/запись дисковых секторов безотносительно их логической привязки к тому или иному файлу). В этой главе обсуждаются общие проблемы работы с дисками и описываются средства модуля F_Disk, содержащего набор соответствующих подпрограмм.

Работа с диском на физическом уровне требует от программиста предельного внимания, так как ошибочное обращение может безвозвратно нарушить файловую структуру. Я настоятельно рекомендую использовать описываемые в этом разделе средства только в случае крайней необходимости, когда стандартные подпрограммы не могут обеспечить требуемого результата. Думаю, что Вы будете достаточно благоразумны и пожертвуете отдельную дискету для Ваших экспериментов с диском.

3.1. СТРУКТУРА ДИСКОВ ДОС

Чтобы работать с диском на физическом уровне, необходимо ясно представлять себе детали устройства и особенности использования диска. В этом разделе излагаются минимальные сведения о физическом устройстве и логической организации дисковых накопителей, используемых в ПК.

3.1.1. Принцип работы дисковых накопителей

Любой дисковый накопитель информации использует принцип независимого перемещения диска и головок считывания/записи. Диск имеет двустороннее ферромагнитное покрытие и вращается специальным двигателем со строго постоянной скоростью. С каждой стороны диска к ферромагнитному слою тесно прилегают по одной головке считывания/записи (см. рис.3.1).

Головки могут перемещаться в радиальном направлении отдельным шаговым приводом и фиксироваться в любом новом положении. Собственно говоря, только возможностью перемещения головок относительно диска дисковые накопители радикально отличаются от обычных бытовых магнитофонов, во всем остальном принципы их действия очень схожи:

головки взаимодействуют с вращающимся ферромагнитным слоем диска и записывают или считывают информацию подобно тому, как записывается или считывается звук на магнитной ленте. Однако в отличие от магнитофонов для поиска нужной информации на диске не требуется просматривать всю записанную информацию от самого начала, а достаточно


h0055.htm

просто сместить головки к нужной дорожке. Такой способ доступа к информации называется произвольным, в то время как используемый в ленточных накопителях последовательный просмотр ленты для поиска информации называется последовательным способом доступа.

Рис.3.1. Головки и дорожки дискового накопителя

Головки взаимодействуют с покрытием только после прекращения радиального перемещения и фиксации в новом положении, поэтому каждое новое положение головки оставляет на поверхности вращающегося диска невидимые следы в виде концентрических окружностей. Эти следы называются дорожками. Каждая дорожка по окружности делится на одинаковое количество секторов, в пределах которых и осуществляется запись/считывание информации. Программы дисковой операционной системы MS-DOS записывают в любой сектор информацию объемом не более 512 байт. Таким образом, общая емкость D любого гибкого диска, используемого ДОС, составляет

D = 512*Nt*Ns*2 байта,

где Nt — количество дорожек, Ns — количество секторов на дорожке, а множитель 2 учитывает две поверхности дискеты. Например, для широко распространенных дискет диаметром 133 мм (5'/4 дюйма) для формата DSDD [Double Side, Double Density — две стороны, двойная плотность) Nt = 40, Ns = 9, поэтому емкость равна

D == 512*40*9*2 = 360*1024 = 360 Кбайт,

а для формата DSHD (Double Side, High Density — две стороны, высокая плотность) Nt = 80, Ns = 15 и емкость дискеты составляет

D = 512*80*15*2 = 1200*1024 1.2 Мбайт.


h0056.htm

В конструктивном отношении различают накопители на гибких дискетах (ГД) и на жестких дисках (ЖД). Принцип действия обоих устройств одинаков, однако ЖД имеют значительно большую емкость и существенно меньшее время доступа (т.е. время поиска нужного сектора и обмена информации), чем ГД. С другой стороны, ГД могут легко выниматься и вставляться в накопитель, что делает их незаменимым средством обмена данными и программами между ПК. Увеличенная емкость ЖД достигается значительным по сравнению с ГД увеличением скорости вращения диска, что позволяет записывать на нем данные с большей плотностью. В результате ЖД обычно имеет больше дорожек и секторов. Кроме того, в накопителях этого типа, как правило, используется несколько дисков, закрепленных на одном шпинделе. С каждым диском взаимодействует своя пара головок (по Одной на каждую поверхность). Головки закрепляются на одном держателе и одновременно перемещаются в радиальном направлении. Совокупность всех дорожек на всех дисках для одного какого-либо положения головок называется цилиндром.

Перемещение головок и информационный обмен данными осуществляется под управлением специального устройства, называемого контроллером диска. Обычно в ПК используются два контроллера — для ГД и ЖД, иногда оба типа дисковых накопителей управляются общим контроллером.

3.1.2. Логическая структура дисков

С физической точки зрения все секторы одинаковы — как уже говорилось, их емкость в MS-DOS всегда равна 512 байтам. Однако программы операционной системы закрепляют за каждым сектором некоторые определенные функциИг что позволяет говорить о логической структуре дисков.

Любой диск в ДОС имеет четыре логических части: загрузочный сектор, таблицу распределения файлов, корневой каталог и архивное пространст — во.

Загрузочный сектор

Загрузочный сектор — это самый первый сектор на самой внешней (нулевой) дорожке. Загрузочный сектор содержит важную информацию о логической структуре диска и короткую программу начальной загрузки. Содержимое загрузочного сектора автоматически считывается в оперативную память после включения ПК, затем управление передается программе начальной загрузки. Эта программа считывает в память нужные части операционной системы и передает им управление. Таким образом, загрузочный сектор нужен прежде всего для начальной загрузки операционной системы.

Начиная с байта с порядковым номером 12, в загрузочном секторе размещается так называемый блок параметров BIOS (BPB), содержащий информацию о длине и расположении остальных логических частей диска и некоторые другие важные параметры. Информация в BPB соответствует следующему типу данных:


h0057.htm

type

BPB_Type = record

SectSiz Word; {Количество байт в секторе:

для MS-DOS всегда 512 байт}

ClustSiz Byte; {Количество секторов в кластере} ResSecs Word; {Количество секторов перед FAT) FatCnt Byte; {Количество копий FAT} RootSiz Word; {Количество элементов корневого каталога} TotSecs Word; {Количество секторов на диске} Media Byte; {Дескриптор носителя} FatSize Word {Количество секторов в FAT} end; {BPB_Type}

В этой структуре поле SectSiz, определяющее размер сектора в байтах, для любых операционных систем, совместимых с MS-DOS, всегда имеет значение 512. Дисковые накопители могут читать и записывать секторы и другого размера — 128, 256 или 1024 байта. Такие секторы не могут обслуживаться ДОС и являются для нее «плохими» — при попытке доступа к ним программы ДОС выдадут сообщения об ошибке. Это обстоятельство широко используется для защиты программ от несанкционированного копирования (см. гл.7).

Несколько смежных секторов диска объединяются в группу, называемую кластером. Кластер — это минимальная порция дискового пространства, которую ДОС может выделить файлу. Поле ClustSiz содержит количество секторов в одном кластере. Обычно это число представляет собой степень двойки: 1, 2, 4, 8 и т.д. Причем чем больше объем диска, тем крупнее кластер. Для ГД размер кластера чаще всего составляет 2 сектора (для дискет диаметром 5'/4 дюйма) или 1 сектор (ЗУз дюйма). Для ЖД в кластер обычно входят 4, 8 или 16 секторов.

Поле Media определяет тип носителя информации. Стандартными значениями этого поля могут быть:

$FF - дискета 320 Кбайт (2 стороны, 8 секторов);

$FE - дискета 160 Кбайт (1 сторона, 8 секторов);

$FD - дискета 360 Кбайт (2 стороны, 9 секторов);

$FC - дискета 180 Кбайт (1 сторона, 9 секторов);

$F9 - дискета 1.2 Мбайт (2 стороны, 15 секторов);

$F8 - жесткий диск.

Как показывает практика, содержимое поля Media не всегда соответствует действительности (например, во многих случаях жесткий диск имеет дескриптор $00). Пожалуй, единственным относительно надежным признаком может служить информация в трех младших битах этого поля (табл.3.1).

Таблица 3.1 Значения младших бит поля Media

Разряд | Значение | Признак
0 | i | Испояьзуются 2 стороны носителя


h0058.htm

58 Глава 3

 | 0 | Используются не 2 стороны
1 | 1 | На дорожке 8 секторов
 | 0 | На дорожке не 8 секторов
2 | 1 | Съемный носитель информации
 | 0 | Несъемный носитель информации

Назначение остальных полей ВРВ будет пояснено дальше. Сразу за ВРВ (начиная с байта с номером 25) в загрузочном секторе располагается следующая структура данных:

type

Add_BPB_Type = record

TrkSecs: Word; {Количество секторов на дорожке}

HeadCnt: Word; {Количество головок)

HidnSec: Word {Количество спрятанных секторов}

end; {Ad.d_BPB__Type}

Поле HidnSec содержит общее количество «спрятанных» секторов, т.е. секторов, не относящихся к логической структуре диска (см. ниже). Начиная с версии 4.0 в ДОС вошли средства, поддерживающие жесткие диски большого размера (больше 32 Мбайт). Поэтому для версий 4.х и выше структура данных, располагающихся за ВРВ, такова:

type

Add_BPB_4_Type = record

TrkSecs : Word; {"Количество секторов на дорожке}

HeadCnt : Word; {Количество головок}

HidnSecLo: Word {Младшее слово количества спрятанных секторов}

HidnSecHi: Word {Старшее слово}

TotSecs : Longint {Полное количество секторов на диске) end; {Add._BPB_4_Type}

Признаком того, что используется расширенный блок ВРВ, является значение 41 (символ «)») в 39—м по счету байте загрузочного сектора.

Физический диск может быть разбит на несколько логических разделов, каждый из которых имеет свою логическую структуру. С точки зрения пользователя, каждый раздел выступает как самостоятельный диск и называется логическим диском. Разбивка физического диска на ряд логических устройств осуществляется утилитой FDisk операционной системы или подобными ей несистемными средствами (ADM, Disk Manager и т.п.). Если диск разбит на разделы, в конце загрузочного сектора выделяется 64—байтное поле описателей разделов (по 16 байт на каждый логический диск). Это поле начинается с байта с номером 447 (смещение $1ВЕ от начала сектора). Каждый описатель раздела, создаваемый утилитой FDisk, соответствует такой структуре данных:

type

Part_Type = record

BootF: Byte; {Флаг активности раздела} BegHd: Byte; {Начало раздела - номер головки}


h0059.htm

BegSC Word; {Начало раздела - сектор/цилиндр} Sys Byte; {Код системы} EndHd Byte; {Конец раздела - номер головки} EndSC Word; {Конец раздела - сектор/цилиндр} Sees Longint; {Относительный номер начального сектора} Size Longint; {Длина раздела в секторах} end; {Part_Type}

Описываемая логическая структура (загрузочный сектор, таблица распределения файлов и т.д.) создается на каждом логическом диске, т.е. на одном физическом диске существует несколько (по числу логических разделов) загрузочных секторов. Самый первый загрузочный сектор называется главным — именно он используется для начальной загрузки операционной системы. Этот сектор программами BIOS считывается в буфер, начинающийся по адресу $7СОО:$0000, и по этому же адресу передается управление. Получив управление, главный загрузчик просматривает таблицу разделов диска и выбирает раздел (логический диск), имеющий признак активности в поле BootF (если диск активен, это поле имеет значение $80, в противном случае — 0). Затем в память считывается соответствующий загрузочный сектор и управление передается ему. Таким образом, если ЖД разбит на разделы, загрузка ДОС проходит в два этапа. Это позволяет иметь на одном диске несколько загрузчиков для разных операционных систем. Например, активный логический диск может нести сетевую операционную систему, в этом случае его загрузчик осуществляет загрузку этой системы.

В большинстве случаев разделы физического диска соответствуют одной и той же операционной системе и используются для более удобной структуризации больших объемов дисковой памяти.

При анализе главного загрузочного сектора следует иметь в виду важное соглашение ДОС: описатели логических разделов диска построены по принципу связанного списка (см. рис.3.2).

В секторе главного загрузчика используются лишь два описателя Part_Type из четырех возможных: первый описатель (он называется описателем первичного раздела ДОС) определяет физическое расположение и параметры логического диска С, а второй (описатель расширенного раздела ДОС) — расположение на диске следующего описателя. В секторе, соответствующем второму описателю, значащими являются только два поля Part_Type, первое из которых определяет логический диск D, а второе содержит ссылку на новый описатель и т.д.

Таким образом, поля Part_Type во всех загрузочных секторах, кроме главного, не несут полезной информации и должны игнорироваться, а параметры дисков определяются связанным списком описателей, начало которого содержится в главном загрузчике.

Следующая программа считывает главный загрузчик и организует просмотр связанного списка описателей логических разделов первого жесткого диска.


h0060.htm

60 Глава 3

Рис.3.2. Связанный список описателей жесткого диска

^+—————————————————————————————+

¦ Эта программа считывает ссылочную структуру \ ¦ описателей разделов первого жесткого диска \ ¦ и выводит на экран таблицу логических дисков \ +----------------------------------------------+

;

Uses DOS;

Function ReadSec(Disk,Head: Byte;

CylSec: Word; var Buf): Boolean;

{Обеспечивает считывание абсолютного сектора с помещыо прерывания $13 и возвращает TRUE, если нет ошибки} var

R: Registers;

begin

with R do begin

ah =2; {Код операции чтения}

al =1; {Колич. читаемых секторов}

dl = Disk; {Номер диска: 0,1 - ГД,80,$81 - ЖД}

dh = Head; {Номер головки}

сх = CylSec; {Сектор и цилиндр}

es = seg(Buf); {Адрес буфера в ES:BX}


h0061.htm

bx := ofs(Buf) ;

Intr($13,R) ;

ReadSec := (Flags and FCarry)=0 end

end; {ReadSec} {————————————}

type

{Описатель раздела} Part_Type = record

BootF: Byte {Флаг активности раздела} BegHd: Byte {Начало раздела - головка} BegSC: Word {Начало раздела - сектор/цилиндр} Sys : Byte {Код системы} EndHd: Byte {Конец раздела - головка} EndSC: Word {Конец раздела - сектор/цилиндр} Sees : Longint; {Относительный номер начального сектора} Size : Longint; {Длина раздела в секторах} end; {Part_Type} {Структура ссылочного сектора} BootSecType = record

a: array [O..$1BD] of Byte;

Part: array [1..4] of Part_Type;

b: array [1..2] of Byte end;

const

MAXPART = 24; {Максимальное количество логических дисков} var

Boot : BootSecType;

Disk : array [1..MAXPART] of record

Hd: Byte; {Головка} Tr: Word; {Дорожка} Se: Byte; {Сектор} PT: Part_Type;

end;

k,d,j: Byte;

begin

Q := 0; {Номер очередного логического диска} {Читаем главный загрузчик}

if not ReadSec($80,0,1,Boot) then begin

WriteLn('Ошибка чтения главного загрузчика');

Halt end;

{Формируем адрес описателя диска С} Disk[l].Hd := 0;

Disk[l].Tr := 0;


h0062.htm

Disk[l].Se := 1;

{Цикл чтения описателей логических дисков} with Boot do repeat

k := 1; {Ищем непустой описатель} while (Part[k] .BegSOO) and (k<4) do inc (k) ;

if k<=4 then

begin {Найден непустой описатель} if cKMAXPART then begin

inc(d); {Номер очередного диска} Disk[d].PT := Part[k] {Сохраняемго описатель} end;

inc(k); {Part[k] -ссылка на следующий

описатель раздела}

if (k<=4) and (Part [k] .BegSCOO) then with Part[k],Disk[d+1] do

begin {Адрес очередного описателя} Hd := BegHd;

Tr := (BegSC and 192) shi 2+BegSC shr 8;

Se := BegSC and 63 end end;

{Продолжаем цикл до ошибки чтения или

пустой ссылки на очередной описатель} until (Part[k].BegSC=0) or (k>4) or

not ReadSec($80,Part[k].BegHd,Part[k].BegSC,Boot) ;

{Выводим таблицу логических дисков} Write(#13#lO#lO'nHCK',' ':8);

for j := 1 to d do

Write(chr(ord('B')+j):10) ;

Write(#13#10'Активный',' ':4);

for j := 1 to d do with Disk[j].Pt do if BootF=$8O then

Write(^a' :10) else

Write('Нет':10) ;

Write(#13#10'Код системы ');

for j := 1 to d do with Disk[j].Pt do Write(Sys:10) ;

Write(#13#10'Объем (байт)');

for j := 1 to d do with Disk[j].Pt do Write(Size*512:lO) ;

WriteLn(#13#10'Начало:') ;

Write(' OTH.сектор');

for j := 1 to d do with Disk[d].Pt do


h0063.htm

Write (Sees:10) ;

Write (#13#10' головка ');

for j :== 1 to d do with Disk[j].Pt do

Write(BegHd:10) ;

Write(#13#10' дорожка ');

for j := 1 to d do with Disk[j].Pt do

Write((BegSC and 192) shi 2+ BegSC shr 8:10);

Write (#13#10' сектор ');

for j := 1 to d do with Disk[j].Pt do

Write(BegSC and 63:10);

WriteLn(#13#10'Описатель:') ;

Write (' головка ');

for j := 1 to d do with Disk[j] do

Write(Hd:10) ;

Write (#13#10' дорожка ');

for j := 1 to d do with Disk[j] do

Write (Tr:10) ;

Write (#13#10' сектор ');

for j := 1 to d do with Disk[j] do

Write(Se:lO) ;

WriteLn end.

В этой программе для доступа к физическим секторам используется прерывание BIOS $13, которое подробно описывается в п.3.2.

Поле Sys описателя раздела может иметь одно из значений, указанных в табл.3.2.

Таблица 3.2

Значения поля SYS

Значение | Смысл
о | Неизвестная операционная система
1 | Операционная система MS-DOS, 12-битная FAT
4 | Операционная система MS—DOS, 16-битная FAT
5 | Описатель логического раздела

Таблица распределения файлов

За загрузочным сектором располагается так называемая таблица распределения файлов [File Allocation Table — FAT). Эта таблица начинается в секторе BPB.ResSecs и содержит информацию о принадлежности каждого кластера тому или иному файлу. Обычно на диске создается несколько копий FAT (чаще всего две копии), содержимое которых строго идентично. Дублирование информации в нескольких копиях FAT повышает надежность ее хранения. Количество копий FAT и размер каждой копии (в секторах) задаются полями FATCnt и FATSize блока ВРВ.


h0064.htm

FAT представляет собой однородную структуру элементов, каждый из которых логически связан с одним кластером диска. Элементы FAT нумеруются, начиная с номера 0, однако первые два элемента используются особым образом, так что кластеры имеют номера, начиная с 2. Чтобы определить, занят ли кластер с номером N, нужно проанализировать N—й элемент FAT: если элемент содержит 0, кластер не занят полезной информацией, в противном случае он содержит ссылку на следующий связанный с ним кластер или специальный признак конца ссылок.

При выделении дискового пространства новому файлу ДОС ищет в FAT первый незанятый кластер и помещает номер этого кластера в связанный с файлом элемент каталога (см. ниже). Если файл целиком умещается в одном кластере, в соответствующий элемент FAT помещается признак занятости, в противном случае — номер того кластера, в котором находится продолжение файла (см. рис.3.3).

Рис.3.3. Цепочка ссылок FAT

Как видно из этого рисунка, файл MYFILE. ТХТ начинается в кластере с номером $08 и занимает кластеры $08, $09, $ОА, $ОВ, $15, $16, $17, $19, $1Аи$1В.

В ДОС используются FAT двух типов: с 12— и 16—битными элементами. В первом случае два смежных кластера описываются трехбайтной последовательностью, так что на каждый кластер приходится полтора байта описателя. Такие таблицы используются на дискетах и жестких дисках небольшой емкости (до 10 Мбайт). В 16-битных FAT под каждый описатель выделяются два байта. Начиная с версии 4.0, в загрузочном лекторе со смещением 54 байта от начала располагается 8—байтное поле с символами 'FAT 12' или 'FAT16' в зависимости от типа элементов FAT. Для предыдущих версий ДОС такого явного указания типа FAT нет. Вместо этого используется следующее соглашение: если общее количество кластеров больше 4080 или общее количество секторов больше 20740, FAT использует 16—битные элементы. Значение 4080 определяется как полная емкость 12—разрядного числа (4096) минус 16 номеров, зарезервированных для особых применений (указатели конца цепочки и плохих кластеров). Значение 20740 определяет максимальную емкость логического диска в 10 Мбайт: если диск имеет большую емкость, его FAT оперирует с


h0065.htm

16 — разрядными элементами. Замечу, что поле 5ys в описателе логического диска содержит 1 или 4 в зависимости от типа FAT.

Первый байт FAT содержит значение ID, совпадающее с дескриптором носителя Media из ВРВ. Два следующих за ним байта для 12—разрядной или 3 байта для 16—разрядной FAT всегда имеют значение $FF. Таким образом, элементы 0 и 1 FAT используются особым образом, поэтому нумерация кластеров начинается с номера 2. Старшие номера кластеров, начиная с номера $FFO для 12—разрядной и $FFFO для 16—разрядной FAT, используются для специальных целей (в скобках указаны значения для 16—разрядной FAT):

от $FFO ($FFFO) до $FF6 ($FFF6) — зарезервированные кластеры;

$FF7 ($FFF7) — плохой кластер;

от $FF8 ($FFF8) до $FFF ($FFFP) — конец цепочки ссылок.

Структура каталогов

Сразу за последней копией FAT на диске располагается корневой каталог. Содержимое каталога описывает все зарегистрированные в нем подкаталоги и файлы и выводится на экран командой DIR операционной системы. Каждый элемент корневого каталога и всех подкаталогов представлен такой 32 — байтной структурой данных:

type

Dir_Type = record

Name array [1..8] of Char; {Имя файла}

Ext array [1..3] of Char; {Расширение}

FAttr Byte; {Атрибуты файла}

Reserv array [1..10] of Byte; {Резерв}

Time Word; {Время создания}

Date Word; {Дата создания}

FirstC Word; {Номер первого кластера}

Size Longint {Размер файла в байтах}

end; {Dir_Type}

Символы в полях Name и Ext обычно преобразуются к прописным и выравниваются влево, т.е. неиспользуемые символы имени и расширения заполняются ведомыми пробелами. Для имен каталогов оба поля рассматриваются как одно целое, таким образом имя каталога может состоять из 11 символов.

Байт FAttr содержит атрибут файла. ДОС использует значения этого поля, указанные в табл.3.3.

Таблица 3.3 Значения поля FAttr

Значение | Смысл
о | Обычный (архивный) файл
i | Файл защищен от изменений и стирания
2 | Скрытый файл
4 | Системный файл


h0066.htm

66 Глава 3

8 | Идентификатор тома
$10 | Подкаталог
$20 | Признак архивации

Допускается комбинация перечисленных признаков. Например, элементы каталогов для системных файлов IBMBIO.COM и IBM.DOS.COM. обычно содержат в поле FAttr значение 7 = 1+24-4, что расшифровы — вается как скрытые системные файлы, защищенные от изменения и стирания.

Поле FirstC указывает на номер кластера, в котором располагается начало файла или каталога. Одновременно этот номер открывает цепочку ссылок FAT, если файл (каталог) не умещается в одном кластере.

Для каждого подкаталога элемент с именем «.» содержит ссылку на корневой каталог, а с именем «..» — на каталог вышележащего уровня. Если файл (подкаталог) удаляется из каталога, первая буква его имени заменяется на символ «х» (#120) и освобождается вся связанная с этим элементом цепочка ссылок FAT. Поскольку поле FirstC сохраняет свое прежнее значение, это дает возможность в некоторых случаях восстановить ошибочно стертый файл.

Признаком конца использующейся части каталога является элемент, в котором первый символ в поле Name имеет значение # 0.

3.2. СРЕДСТВА BIOS И ДОС ДЛЯ РАБОТЫ С ДИСКОМ

Операционная система ПК состоит из двух частей: программ базовой системы ввода/вывода [BIOS) и собственно программ ДОС (MS—D05, PC— DOS, OS/2, DR—DOS и т.п.). Программы BIOS располагаются в постоянном запоминающем устройстве (ПЗУ), программы самой ДОС — в системных файлах (например, для операционной системы MS-DOS это файлы IBMBIO.COM и IBMDOS.COM). В этом разделе описываются средства операционной системы MS-DOS версии 4.0 и более ранних. При использовании других операционных систем могут быть незначительные отличия в способах доступа к ним.

3.2.1. Прерывание BIOS $13

В состав BIOS входит программа работы с диском, доступ к которой открывает программное прерывание $13. Подобно большинству других прерываний BIOS в прерывании $13 предусмотрено несколько функций, связанных с тем или иным конкретным действием. Эти функции определяются содержимым регистра АН и имеют смысл, указанный в табл.3.4.

Таблица 3.4 функции прерывания $13______________

Функция | Действие | Класс ПК
$00 | Сбросить контроллер диска | PC,XT,AT,PS/2
$01 | Получить статус диска | 11
$02 | Читать сектор | ii
$03 | Записать сектор | "


h0067.htm

Работа с диском на физическом уровне 67

$04 | Проверить сектор | о
$05 | Форматировать дорожку | "
$С6 | форматировать дорожку ЖД | PC. XT
$07 | форматировать ЖД | "
$08 | Получить параметры диска | PC,XT,AT,PS/2
$09 | Инициировать контроллер диска на основе дисковых таблиц | «
$ОА | Читать сектор с кодом коррекции | "
$ОВ | Записать сектор с кодом коррекции | "
$ОС | Позиционировать головки на нужный цилиндр | n
$OD | Сбросить контроллер диска | 11
$ОЕ | Читать буфер сектора | PC, XT
$OF | Записать буфер сектора | "
$10 | Получить состояние дисковода ЖД | PC,XT,AT,PS/2
$11 | Осуществить рекалибровку дисковода ЖД | "
$12 | Проверить память контроллера ЖД | PC, XT
$13 | Проверить дисковод ЖД | 11
$14 | Проверить контроллер ЖД | PC,XT,AT,PS/2
$15 | Получить тип и размер диска | AT,PS/2
$16 | Проверить флаг дискеты | "
$17 | Установить тип дискеты | и
$18 | Установить среду для форматирования дискеты | "
$19 | Парковать головки ЖД | "
$1А | форматировать ЖД с контроллером типа ESDI | "

Номер диска при обращении к прерыванию $13'указывается как целое число: если это число меньше $80, номер относится к приводу гибкого диска (0 означает первый привод ГД), если $80 или больше, к жесткому диску ($80 означает первый ЖД). Минимальный номер цилиндра и головки равен 0, а минимальный номер сектора равен 1.

Старший байт Пладший байт

Рис. 3.4. Структура номеров цилиндра и сектора для прерывания $13

Номер цилиндра/сектора передается через регистр СХ в упакованном виде (см. рис.3.4): номер сектора занимает младшие 6 бит регистра CL, в то время как биты 6 и 7 этого регистра рассматриваются как старшие биты номера цилиндра; младшие биты номера цилиндра задаются значением регистра СН.

Большинство функций прерывания $13 возвращает в флаге переноса CF признак обнаруженной ошибки (0 — нет ошибки, 1 — обнаружена ошиб — ка), а в регистре АН — код ошибки. Если это не оговаривается особо, код ошибки трактуется следующим образом (табл. 3.5):

Т а б л.и п. а 3.5 Значения кода ошибки для прерывания $13

Код

Значение


h0068.htm

68 Глава 3

00 | Нет ошибки
$01 | Неправильная команда
$02 | Не найдена адресная метка
$03 | Попытка записи на диск, защищенный от записи
$'04 | Не найден сектор
$05 | Ошибка при сбросе ЖД
$06 | Произошла замена дискеты (изменялось положение запора дискового привода)
$0-7 | Неправильные параметры дисковода ЖД
$08 | Переполнение канала прямого доступа к памяти (КПДП)
$09 | Выход за границу 64 Кбайт при работе КПДП
$ОА | Обнаружен плохой сектор
$ОВ | Обнаружена плохая дорожка
$ОС | Неправильный номер дорожки
$OD | Неправильный номер сектора при форматировании
$OE | Обнаружена адресная метка управляющих данных
$OF | Ошибка КПДП
$10 | Обнаружена ошибка в данных
$11 | Данные скорректированы схемами контроля
$20 | Сбой контроллера
$40 | Сбой при поиске дорожки
$8t) | Программа не успевает обрабатывать данные (ошибка таймаута)
SAA | Не готов дисковод
$ВВ | Неизвестная ошибка
$СС | Сбой при записи
$ЕО | Ошибка регистра состояния
$FF | Ошибка операции чтения

Сбросить контроллер диска

Вход: АН = 0;

DL — номер диска.

функция $00 вызывает сброс и рекалибровку контроллера дисков (головки устанавливаются на нулевой цилиндр). Сброс рекомендуется выполнять после того, как произошла ошибка при выполнении других операций, например при чтении данных. После сброса можно попытаться выполнить неудавшуюся операцию еще раз.

Получить статус диска

Вход: АН = 1;

DL — номер диска. Выход: AL — признак ошиЬки предыдущего обращения к диску

(совпадает со значением АН в остальных функциях)

Функция $ 01 используется для анализа предыдущей дисковой операции. Передаваемый в регистре AL код завершения операции берется из области данных BIOS — из байта по адресу $0000 : $0441.

Читать/записать сектор

Вход: АН = 2 — читать сектор;

-= 3 — записать сектор, AL — количество секторов, которые нужно прочитать (записать);

СХ — цилиндр/сектор;


h0069.htm

DH — номер головки;

DL — номер диска;

ES'.BX — адрес буфера.

Функции $02 и $03 используются соответственно для чтения и записи данных. Обмен данными с диском осуществляется порциями, кратными размеру сектора диска (для ДОС этот размер составляет 512 байт). При осуществлении операции используется контроллер прямого доступа к памяти (КПДП), схемы управления которым позволяют за одно обращение передать до 64 Кбайт данных, причем передача идет под управлением схем КПДП (без участия микропроцессора). КПДП не может проверить действительный размер буфера, выделенного для обмена данными с диском;

ответственность за неправильную длину буфера возлагается на программиста.

Функции $02 и $03 позволяют обратиться к любому физическому сектору (или группе смежных секторов). В частности, только с их помощью возможен доступ к сектору главного загрузчика. Если данные читаются (записываются) из нескольких секторов, т.е. если регистр AL > 1, обмен данными идет начиная с цилиндра и сектора, заданных в регистре СХ, по секторам до конца дорожки, далее по головкам до конца цилиндра, затем по цилиндрам.

Проверить сектор

Вход: АН" = 4;

AL — количество проверяемых секторов;

СХ — цилиндр/сектор;

DH — номер головки;

DL — номер диска.

С помощью функции $04 программа может убедиться в доступности указанных секторов. Данные проверяются по методу циклического контроля (CRC), однако обмен данными не осуществляется, поэтому при обращении к функции ей не нужен адрес буфера*. Перед обращением программа должна убедиться в готовности дисковода (мотор привода диска должен вращаться с рабочей скоростью), в противном случае будет установлен признак ошибки.

Форматировать дорожку

Вход: АН = 5;

AL — для ГД — количество секторов на дорожке, для ЖД — фактор чередования секторов;

СХ — цилиндр/сектор;

DH — номер головки;

DL — номер диска;

ES:BX — адрес данных для форматирования.

' На ПК, выпущенных до 15.11.85, буфер в ES:BX должен содержать эталон тестируемого сектора.


h0070.htm

Функция форматирования дорожки $05 предназначена для начальной записи служебных данных на поверхность диска. При выполнении операции уничтожаются все ранее записанные на дорожке данные. За одно обращение к функции можно отформатировать только одну дорожку (или ее часть) — от указанного сектора и до конца дорожки. Для этой функции необходимо задать фактор чередования секторов и определенным образом подготовить буфер данных.

фактор чередования секторов определяет последовательность расположения секторов в пределах одной дорожки, фактор 1 означает последовательное расположение секторов в порядке их номеров — сначала сектор 1, за ним сектор 2 и т.д., т.е. в этом случае чередование отсутствует. Фактор 2 задает расположение секторов через один. Например, при 9 секторах на дорожке секторы будут следовать в порядке 1—6—2—7—3— 8—4—9—5. При последовательном расположении секторов может оказаться так, что процессор не будет успевать обрабатывать данные в смежных секторах за один оборот диска. В этом случае чередование секторов позволяет согласовать производительность процессора со скоростью обмена данными и за счет этого повысить общую скорость работы с диском.

Буфер данных для форматирования дискеты должен содержать NSec 4 — байтных элементов, где N5ec — количество форматируемых секторов. Иными словами, для каждого сектора необходимо подготовить 4 информационных байта, в которых указываются номера дорожки, головки, сектора и код длины сектора. Последний определяет размер сектора и может иметь следующие значения:

О - 128 байт 1-256 байт

2 - 512 байт

3 - 1024 байт

Порядок следования в этом буфере секторных номеров определяет фактор чередования. Например, если форматируются девять 512—байтных секторов на дорожке с номером $10, головка 1, фактор чередования 2, то буфер должен содержать следующие данные:

$10, $01, $01, $02, $10, $01, $06, $02, $10, $01, $02, $02, $10, $01, $07, $02, $10, $01, $03, $02, $10, $01, $08, $02, $10, $01, $04, $02, $10, $01, $09, $02, $10, $01, $05, $02

Перед обращением к функции форматирования дискеты таблица параметров дискеты должна содержать правильные параметры, а контроллер диска должен быть настроен на нужную скорость передачи данных.

Таблица параметров дискеты (ТПД) — это 11—байтный информационный блок, начало которого указывает вектор прерывания $1Е. Этот блок содержит некоторые константы, которые используются драйвером диска для управления дисководом. Структура ТПД:

type


h0071.htm

DPT = record

StepRTm: Byte; {Задержка переключения головок} DMA : Byte; {Признак использования КПДП} DrvOff : Byte; {Задержка выключения двигателя} SectSiz: Byte; {Код размера сектора} SectCnt: Byte; {Количество секторов на дорожке} GapSize: Byte; {Длина межсекторного промежутка} DataSiz: Byte; {Максимальная длина передаваемых данных} GapFSiz: Byte; {Межсекторный интервал для форматирования} FillChr: Byte; {Символ-заполнитель для форматирования} HeadTm : Byte; {Время установки головок} StartTm: Byte; {Время запуска двигателя} end;

Большинство полей ТПД содержит оптимальные технические параметры ГД, которые не следует изменять. Исключение составляют поля SectSiz, SectCnt и FillChr. Поле SectSiz содержит код длины сектора. Поскольку MS-DOS работает только с 512—байтными секторами, это поле имеет значение 2 во всех случаях, кроме специальных средств защиты программ (подробнее см. гл.7). Поле SectCnt должно содержать количество секторов на дорожке. Это поле может изменяться, если привод ГД позволяет работать с дискетами разного формата. Например, контроллеры ГД для дискет диаметром 5'/4 дюйма могут работать в режиме DSHD (емкость дискеты 1.2 Мбайт) и DSDD (360 Кбайт). В первом случае на дорожке размещается 15, а во втором — 9 секторов, поэтому при переходе с одного формата дискет на другой необходимо нужным образом скорректировать поле SectCnt. Наконец, символ—заполнитель FillChr может быть любым символом в диапазоне ASCII— кодов О...255. Этот символ записывается в область данных при форматировании. Изменение полей ТПД обычно требуется лишь в особых режимах форматирования, используемых для защиты программ от нелегального копирования. Если Вы захотите по— экспериментировать с нестандартными значениями ТПД, учтите, что в некоторых случаях вектор $1Е содержит адрес таблицы, размещенной в ПЗУ. Изменить такую таблицу, разумеется, невозможно, поэтому следует скопировать ТПД в оперативную память, изменить в этой копии нужные параметры и установить в векторе $1Е адрес новой таблицы.

Скорость передачи данных изменяется для контроллеров, рассчитанных на разные форматы дискет, и устанавливается функцией $18 (см. ниже).

Для жесткого диска буфер форматирования всегда имеет длину 256 2— байтных слов. Младший байт каждого слова содержит признак хорошего сектора (0, если сектор хороший, и $80, если плохой), а старший — номер сектора. Как и в случае дискет, порядок следования секторных номеров определяет фактор чередования.

•Замечу, что буфер формата задается только для ПК класса IBM AT. На машинах IBM XT при форматировании жесткого диска фактор чередования указывается в регистре AL.


h0072.htm

Форматировать одну или несколько дорожек жесткого диска

Вход: АН = 6 — форматировать одну дорожку;

= 7 — форматировать до конца диска;

AL — фактор чередования секторов;

СХ — цилиндр/сектор;

DH — номер головки;

DL — номер диска;

ES:BX — адрес буфера.

Для форматирования жесткого диска могут использоваться специальные функции $06 и $07, параметры обращения к которым совпадают с параметрами функции $05. Функция $06 форматирует одну дорожку, а функция $07 — все дорожки, начиная с указанной в регистре СХ.

Получить параметры диска

Вход: АН = 8;

DL — номер диска.

Выход: BL — тип дисковода (только для AT и PS/2};

DL — количество обслуживаемых контроллером ЖД;

DH — максимальный номер головки;

СХ — максимальный номер цилиндра/сектора;

ES-.DI — адрес таблицы параметров дисковода. С помощью функции $08 программа может определить тип дисковода и

другие его параметры. Тип дисковода возвращается в регистре BL и может

иметь одно из следующих значений:

1 - 360 Кбайт, 40 дорожек, 51/^ дюйма 2-1.2 Мбайт, 80 дорожек, 51/^ дюйма 3 - 720 Кбайт, 80 дорожек, З1/^ дюйма 4-1.4 Мбайт, 80 дорожек, З1/; дюйма

Инициировать контроллер диска на основе дисковых таблиц

Вход: АН = 9;

DL — номер диска.

Функцию инициации контроллера $09 применяют после модификации таблиц параметров жесткого диска. BIOS читает таблицу параметров и нужным образом настраивает контроллер. Таблица параметров первого жесткого диска указывается вектором прерывания $41, а второго (если он есть в ПК) — вектором $46.

Читать/записать сектор с кодом коррекци и

Вход: АН = $ОА — читать сектор;

= SOB — записать сектор;

AL — количество читаемых/ записываемых секторов, СХ — цилиндр/сектор;

DH — номер головки;


h0073.htm

DL — номер диска;

ES'.BX — адрес буфера.

Функции $ОА и $ОВ отличаются от функций $02 и $03 только тем, что дополнительно считывается (записывается) 4—байтный код циклического контроля (CRC), используемый для контроля и коррекции данных.

Позиционировать головки на нужный цилиндр

Вход: АН = $ОС;

СХ — цилиндр/сектор;

DH — номер головки;

DL — номер диска.

С помощью функции $ОС программа может установить головки диска на нужную дорожку. Замечу, что функции чтения и записи данных не требуют предварительного позиционирования головок — они делают это самостоятельно.

Сбросить контроллер диска

Вход: АН = $OD

DL — номер диска

Если программе необходимо сбросить только контроллер ЖД, она может вызвать функцию $OD прерывания $13. В отличие от этого описанная ранее функция 0 сбрасывает все контроллеры, в том числе и контроллер ГД.

Читать/записать буфер сектора

Вход: АН = $ОЕ — читать буфер;

= $OF — записать буфер;

AL — количество читаемых/записываемых секторов;

СХ — цилиндр/сектор;

DH — номер головки;

DL — номер диска;

ES'.BX - адрес буфера.

Контроллеры ЖД в компьютерах PC и XT содержат внутренний буфер данных. Функция $ОЕ читает данные из этого буфера, а функция $ОР записывает данные в буфер контроллера, физического обращения к диску ни в том, ни в другом случае не происходит.

Получить состояние дисковода жесткого диска

Вход: АН = $10;

DL — номер диска.

О готовности диска можно судить по значению байта состояния, возвращаемого в регистре АН. Это значение совпадает с байтом состояния функции $01.


h0074.htm

Рекалибровка дисковода жесткого диска

Вход: АН = $11;

DL — номер диска.

Рекалибровка дисковода, осуществляемая функцией $11, заключается в позиционировании головок диска на нулевую дорожку. Дополнительно в регистре АН возвращается байт состояния дисковода.

Проверка памяти контроллера жесткого диска

Вход: АН = $12;

DL — номер диска.

Функция $12 предназначена для запуска встроенной диагностики дискового контроллера. Она проверяет внутренний буфер сектора и возвращает байт состояния диска. Аналогичные действия осуществляют также функции $13 и $14.

Проверка дисковода жесткого диска

Вход: АН == $13;

DL — номер диска. См. функцию $12.

/ Проверка контроллера жесткого диска

Вход: АН = $14. См. функцию $12.

Получить тип и размер диска

Вход: АН = $15;

DL — номер диска. Выход: АН — тип дисковода;

CX:DX — количество секторов размером 512 байт. Тип дисковода, возвращаемый в регистре АН функцией $15, соответствует следующим значениям:

О - диск отсутствует

1 - ГД без аппаратных средств обнаружения замены дискеты

2 - ГД с контролем замены дискеты

3 - ЖД

Проверить флаг дискеты

Вход: АН = $16;

DL — номер диска. Выход: АН — признак замены дискеты:

О — дискета не менялась;

6 — дискета была заменена.

Контроль замены дискеты осуществляется схемами контроллера ГД по состоянию запора дискеты. Функция $16 возвращает в регистре АН при—


h0075.htm

знак изменения положения этого запора. С помощью этой функции Программа может убедиться в том, что она работает с одной и той же дискетой, и потребовать установить старую дискету, если обмен данными с ней еще не закончился.

Установить тип дискеты

Вход: АН = $17;

AL — устанавливаемый тип дискеты;

DL — номер диска.

При обращении к функции $17 в регистре AL необходимо установить одно из следующих значений:

О - не используется

1 - дискета 360 Кбайт в дисководе 360 Кбайт

2 - дискета 360 Кбайт в дисководе 1.2 Мбайт

3 - дискета 1.2 Мбайт в дисководе 1.2 Мбайт

4 - дискета 720 Кбайт в дисководе 720 Кбайт

Функция сбрасывает флаг замены дискеты и настраивает контроллер ГД на нужную скорость передачи данных.

Установить среду для форматирования дискеты

Вход: АН = $18;

DL — номер диска;

СХ — количество цилиндров/секторов. Выход: CF — признак ошибки:

О — нет ошибки;

I — есть ошибка;

АН = код ошибки:

О — требуемое количество цилиндров/секторов допустимо;

$01 — функция недоступна;

$ОС — функция не поддерживается или неизвестен

тип дисковода;

$80 — не установлена дискета. Перед форматированием дорожки ГД контроллер диска должен быть настроен на нужную скорость передачи данных. Это достигается обращением к функции $18, которая дополнительно сбрасывает флаг замены дискеты.

Парковка головок жесткого диска

Вход: АН = $19;

DL — номер диска.

Парковка диска заключается в выводе головок за рабочую зону с тем, чтобы предотвратить возможную порчу поверхности дисков при транспортировке компьютера. Эту операцию реализует функция $19.


h0076.htm

Форматирование жесткого диска с контроллером типа ESDI

Вход: АН = $1А;

AL — количество элементов в таблице дефектов;

DL — номер диска;

CL — режим форматирования;

ES:BX — адрес таблицы дефектов. Выход: CF, АН — признак и код ошибки

Если диск работает под управлением контроллера с интерфейсом ESDI, для его форматирования используется функция $1А. Эта функция поддерживает таблицу дефектных дорожек и имеет несколько режимов форматирования в зависимости от содержимого регистра CL при обращении к функции:

бит 0=1— игнорировать первичную таблицу дефектов;

бит 1=1— игнорировать вторичную таблицу дефектов;

бит 2=1— обновить вторичную таблицу дефектов;

бит 3=1— выполнить анализ поверхности;

бит 4=1— периодически генерировать прерывание $15;

биты 5...7 — должны быть равны 0.

При установке бита 2 регистра CL содержимое вторичной таблицы дефектов обновляется — в нее заносятся результаты тестирования диска. Для углубленного анализа поверхности диска вначале выполняется форматирование с битом 3=0, а затем анализ поверхности с битом 3=1.

Если при форматировании бит 4=1, то после форматирования очередной дорожки BIOS генерирует прерывание $15 с регистром АН=$ОР. Это прерывание можно использовать для индикации процесса форматирования или для прекращения операции по требованию пользователя.

3.2.2. Поддержка дисков в ДОС

Функции 2 и 3 прерывания $13 позволяют прочитать или записать любой сектор на любом диске. Однако формат обращения к этому прерыванию требует задания нескольких несущественных для программиста, но важных для правильной работы программы параметров, таких как номера головки, цилиндра, сектора на дорожке. Кроме того, это прерывание игнорирует разбивку жесткого диска на логические разделы, что обычно вызывает определенные неудобства, т.к. формат и размещение описателей логических разделов зависят от используемой программы обслуживания логических дисков, например FDisk или Disk Manager. Поэтому для операций чтения/записи чаще используются два специальных прерывания ДОС с векторами $25 и $26. Первое из них реализует чтение, а второе — запись информации. В этих прерываниях ДОС (не путайте с функциями ДОС) принят одинаковый формат использования регистров для обмена управляющей информацией с программой пользователя:

Вход: АХ — номер диска (О—А, 1—В, 2—С и т.д.);

DX — номер сектора;

СХ — количество секторов;

DS:BX = адрес буфера. Выход: CF = 1, если была обнаружена ошибка, иначе 0;


h0077.htm

Работа с диском на физическом уровне__________ ____ 77

AX — код ошибки (если CF=1).

Для дисков большой емкости (больше 32 Мбайт) регистр DX не используется, регистр СХ должен содержать $FFFF (признак обращения к большому диску), а регистры DS:BX содержат адрес такой структуры данных:

type

TLargeDisk = record

StartSec: Longint; {Номер сектора} Nsecs : Word; {Количество секторов) AdrBuf : Pointer; {Адрес буфера}

end;

При реализации доступа к прерываниям $25 и $26 следует учесть, что в процессе их обработки ДОС помещает в вершину стека «лишнее» слово (состояние регистра флагов). По этой причине обращение к прерываниям с помощью стандартной процедуры INTR невозможно, т.к. не обеспечивается правильный выход из процедуры. Кроме того, изменяется содержимое регистров DS и ВР, которые, следовательно, нужно где — то (обычно в стеке) сохранить перед вызовом прерывания, чтобы после завершения обработки прерывания восстановить сохраненные значения. Вот почему доступ к прерываниям $25 и $26 можно программировать только с помощью ассемблера (см., например, процедуру ReadWriteSector в модуле FJDisk).

Среди многочисленных функций ДОС есть несколько весьма полезных при работе с диском. Это прежде всего функция $32. Стандартная документация по MS-DOS не содержит никаких сведений об этой функции. Говорят, что эта функция недокументирована. В отличие от остальных функций недокументированные функции могут не работать в других версиях ДОС (например, в более поздних версиях или в альтернативных разработках конкурирующих фирм). Функция $32 работает в версии 5.0, а также в версиях 4.х, З.х и 2.х MS-DOS. Она возвращает информацию о диске, которую, в принципе, можно получить и из других источников, например из ВРВ или с помощью функции 8 прерывания $13. Достоинством функции $32 является то, что информация о диске собирается воедино в структуру данных следующего типа:

type

PDrvInfo_Type ^DrvInfc^Type;

DrvInfo_Type = record

Drv Byte; {Номер диска: 0-A, 1-В и т.д.}

SubDrv Byte; {Номер устройства внутри драйвера}

SecSize Word; {Размер сектора в байтах}

SecClus Byte; {Количество секторов в кластере минус 1}

ExpClus Byte; {Сдвиг номера кластера}

Boots Word; {Количество загрузочных и резервных секторов}

FatCnt Byte; {Количество копий FAT}

RootSiz Word; {Количество элементов корневого каталога}


h0078.htm

DataSec Word {Номер первого сектора данных} MaxClus Word {Максимальный номер кластера} FatSize Byte {Количество секторов в FAT} _•_-------------_ ддя. MS-DOS 2.х ————————}

RootSec Word {Номер первого сектора корневого каталога}

Head Pointer; {Адрес заголовка драйвера устройства}

Media Byte {Дескриптор носителя}

AccesF Byte {Флаг доступности устройства}

Next PDrvInfo_Type{Ссылка на следующий элемент списка}

DirClus : Word; {Номер начального кластера текущего

каталога или 0 для корневого каталога} DirPath : array [1..64] of Char; {Путь к текущему

каталогу в формате ASCIIZ (с нулем в конце)} {--_---..- ------ для MS-DOS З.х ——-——————}

RootSec Word; {Номер первого сектора корневого каталога}

Head Pointer; {Адрес заголовка драйвера устройства}

Media Byte; {Дескриптор носителя)

AccesF Byte; {Флаг доступности устройства}

Next PDrvInfo Type{Ссылка на следующий элемент списка}

Reserv Word; {Имеет значение 0}

Build Word; {Имеет значение $FFFF,

если данные построены заново} {-—-————Для MS-DOS 4.х и 5.0 ——————}

Reservl Word; {Имеет значение 0} RootSec Word; {Номер первого сектора

корневого каталога} Head Pointer; {Адрес заголовка драйвера устройства} Media Byte; {Дескриптор носителя} AccesF Byte; {Флаг доступности} Next PDrvInfo_Type{Ссылка на следующий элемент списка} Reserv2 Word; {Имеет значение 0} Build Word; {Имеет значение $FFFF,

если данные построены заново} end; {DrvInfo_Type}

В этой структуре поле ExpClus содержит целое число, показывающее, на сколько разрядов влево нужно сместить номер кластера, чтобы получить номер сектора (количество секторов в кластере всегда равно степени 2, т.е.

Размер_кластера = 2s,

таким образом ExpClus = N). Поле BootS фактически содержит номер сектора, в котором начинается FAT, поля DataSec и RootSec определяют начало соответственно области данных диска и корневого каталога.

При обращении к этой функции регистры процессора используются следующим образом. Вход: АН = $32;

DL — номер диска (0 — текущий, 1—А и т.д.). Выход: AL = 0 — нет ошибок


h0079.htm

Работа с диском на физическом уровне 79

= $FF — задан неверный номер диска;

DS:BX — адрес блока информации.

Например, следующая программа читает блок информации о диске и выясняет, в соответствии с какими версиями MS-DOS он построен.

Uses DOS;

type

PDrvInfo = "DrvInfo;

Drvlnfo = record

a: array [0..15] of Byte;

Reserv: Byte; {Признак версий 4.х и выше} b: array [17..27] of Byte;

Reservl: Word end;

var

R: Registers;

P: PDrvInfo;

begin

with R do begin

ah := $32; (Номер функции ДОС} al := 2; {Для диска С:} MSDOS(R) ;

if aloO then

WriteLn('Ошибка обращения к функции: AL = ',а1) else begin

P := ptr(ds,bx) ;

if P^.Reserv^O then

WriteLn('Версия MS-DOS 4.0 и выше') else

if P^-ReservloO then

WriteLn('Версия MS-DOS 3.x') else

WriteLn('Версия MS-DOS 2.x') end end end.

Поскольку функция $32 может не работать в других версиях ДОС, ею следует пользоваться с осторожностью1. В описываемом в п.3.3 модуле F_Disk реализованы приблизительно такие же функции, но с использованием только документированных возможностей MS-DOS. Эти возможности реализуются так называемым общим вызовом IOCTL (Input/Output ConTroL — управление вводом/выводом). IOCTL представляет собой соглашение об интерфейсе (способе обмена данными) между ДОС и

' На моем ПК используется MS-DOS 6.20. Мне не удалось получить информацию о диске С помощью функции $32.


h0080.htm

работающими в ней драйверами устройств ввода/вывода. Этому соглашению обязаны следовать все драйверы (в том числе и разработанные пользователями) для версий MS-DOS, начиная с 2.0 и выше.

Общий вызов IOCTL реализуется прерыванием $21 ДОС со следующими значениями регистров:

АН == $44 (функция $44 ДОС реализует вызов IOCTL)

AL = $OD (подфункция $OD - общий вызов IOCTL)

BL - номер диска (0 - текущий, 1 - А и т.д.)

СН - $08 (код категории устройства: $08 - дисковое устройство)

CL - операция:

$40 - установить параметры устройства

$41 - записать дорожку

$42 - форматировать дорожку

$60 - получить параметры устройства

$61 - прочитать дорожку

$62 - проверить дорожку DS:BX - адрес указателя на блок параметров

При возврате из функции флаг переноса CF содержит 0, если обращение было без ошибок, и 1, если обнаружена ошибка. В случае ошибки регистр АХ содерж IT код ошибки.

Формат блока параметров, адрес которого указывается в регистрах DS:BX, зависит от выполняемой операции.

Получить/установить параметры устройства CL = $б0/$40

При использовании этой операции блок параметров должен соответствовать такой структуре данных:

type

Tracks_Type = record

Trek: Byte; {Номер сектора}

Size: Byte {Длина сектора} end;

IOCTL_Info_Type = record

Control Byte; {Управляющий байт}

TypeDrv Byte; {Тип диска}

Attrib Word; {Атрибуты диска}

Cylindrs Word; {Число цилиндров}

Media Byte; {Тип носителя}

BPB ВРВ_Туре;

Add Add_BPB_Type;

Reserv array [1..1O] of Byte;

Sectors Word; {Количество секторов на дорожке}

Tracks {Образ дорожки}

array [1..Sectors] of Tracks_type


h0081.htm

end;

При обращении к операции $60 (получить параметры) в поле Control используется только один младший бит 0: значение 0 этого бита указывает на то, что надо дать умалчиваемое значение ВРВ (т.е. то, которое хранится в драйвере), а значение 1 требует от драйвера построить блок параметров BIOS заново. К сожалению, операция $60 не поддерживает диски большой емкости и в этом случае возвращает нулевое количество секторов в поле BPB.TotSecs.

В операции $40 (установить параметры) используются три младших бита поля Control:

• бит 0: значение 0 заставляет драйвер использовать ВРВ, подготовленный в этом вызове, а значение 1 — умалчиваемый ВРВ;

• бит 1: значение 1 указывает на то, что драйвер должен игнорировать все данные из блока параметров этого вызова, за исключением образа дорожки;

• бит 2: значение 1 сообщает драйверу, что все секторы на дорожке

имеют одинаковый размер.

Поля TypeDrv, Attrib и Cylindrs в операциях $40 и $60 заполняются драйвером. В поле TypeDrv драйвер возвращает тип устройства:

0-360 Кбайт дискета диаметром 51 / ^ дюйма 1-1.2 Мбайт дискета, 51/^ дюйма

2 - 720 Кбайт дискета, З1/^ дюйма

3 - 160 Кбайт дискета диаметром 8 дюймов

4 - 320 Кбайт дискета, 8 дюймов

5 - жесткий диск

6 - магнитная лента

7 - 1.44 Мбайт дискета, 31/^ дюйма и другие дисковые устройства

Атрибуты устройства возвращаются драйвером в поле Attrib. В этом поле используются только два младших бита:

• бит 0 — признак заменяемости носителя (1 — не заменяется);

• бит 1 — признак возможности аппаратного контроля замены дискеты (1 — есть контроль).

В поле Cylindrs драйвер записывает полное количество цилиндров на физическом устройстве.

Поле Media заполняется драйвером при вызове операции $60 и программой при вызове операции $40. Это поле конкретизирует вид носителя для ГД, поддерживающих различные форматы дискет. Например, для S^/^—f^towiowro привода, рассчитанного на 1,2 Мбайт, значение 0 этого поля сообщает, что используется дискета емкостью 1,2 Мбайт, а 1 — емкостью 360 Кбайт.

Поля ВРВ и Add заполняются драйвером при обращении к операции $60 и подготавливаются программой при обращении к операции $40. Структура этих полей рассмотрена в п.3.1.1.

Поля Sectors и Tracks используются только в функции $40 и заполняются программой. В них драйверу сообщается полное количество сек—


h0082.htm

торов на дорожке (поле Sectors) и описание каждого сектора (поле Tracks). Таким образом, длина поля Tracks зависит от текущего количества секторов на дорожке.

Записать/прочитать дорожку

CL = $41/$61 Структура блока параметров:

type

IOCTL_Read_Write__Type = record

Control Byte; /Всегда содержит 0} Head Word; {Номер головки) Cyl Word; {Номер дорожки}

Sec Word; {Номер сектора; нумерация начинается с 0} MaxSec Word; {Максимальный номер сектора на дорожке} Buf Pointer {Адрес буфера для обмена данными} end;

Обратите внимание: при обращении к IOCTL нумерация секторов, головок и цилиндров начинается с нуля (при обращении к прерыванию $13 секторы нумеруются, начиная с единицы). Таким образом, поле MaxSec содержит количество секторов на дорожке минус 1.

Форматировать/проверить дорожку CL = $42/$62

При обращении к этим функциям блок параметров имеет такую структуру:

type

IOCTL_Format_Type = record

Control: Byte; {Управляющий байт}

Head : Word; {Номер головки}

Track : Word; (Номер дорожки} end;

В поле Control используется только младший бит. При входе его значение 0 указывает на необходимость форматирования дорожки, а значение 1 — проверить, поддерживается ли нестандартный формат дорожки. При выходе значение 0 в этом бите означает, что указанный образ дорожки может использоваться, а значение 1 — не может использоваться.

В заключение обзора возможностей ДОС отмечу еще две полезные функции, функция с номером $Е устанавливает текущий диск (диск по умолчанию). Диск задается содержимым регистра DL перед обращением к функции, после возврата регистр AL содержит общее количество логических дисков, установленных на данном компьютере, функция $19 возвращает в регистре AL номер текущего (умалчиваемого) диска.


h0083.htm

Работа с диском на физическом уровне 83

3.3. МОДУЛЬ FJDisk ДЛЯ РАБОТЫ С ДИСКОМ НА ФИЗИЧЕСКОМ УРОВНЕ

Описываемый в этом разделе модуль F_Disk содержит подпрограммы, рассчитанные на работу с диском на физическом уровне. Все они основываются на изложенной в предыдущих разделах информации о логической организации диска и средствах ДОС. Полный текст модуля приведен в прил.П4.

3.3.1. Описание модуля

В модуле объявляются описанные ранее типы ВРВ_Туре, Add_BPB_Type и Dir__Type, a также глобальные переменные Disk_Error и Disk_Status, в которых указывается признак ошибки и код ошибки последнего обращения к подпрограммам модуля. Поскольку многие процедуры модуля интенсивно используют информацию о диске, а недокументированная функция $32 ненадежна, в модуле используется специальный тип TDisk, собирающий в единое целое всю необходимую информацию о диске, и создается списочная структура, содержащая информацию о всех жестких дисках ПК.

Тип TDisk открывает доступ к следующей структуре данных:

TDisk = record

Number Byte {Номер диска: 0=А,1=В,...}

TypeD Byte (Тип диска}

AttrD Word {Атрибуты диска}

С у Is Word {Число цилиндров}

Media Byte {Дескриптор носителя}

SectSize Word {Количество байт в секторе}

TotSecs Word {Объем диска в секторах}

ClusSize Byte {Количество секторов в кластере}

MaxClus Word {Максимальный номер кластера}

FATLock Word {Номер 1-го сектора FAT}

FATCnt Byte {Количество FAT}

FATSize Word {Длина FAT в секторах}

FAT16: Boolean {Признак 16-битовой FAT}

RootLock Word {Начало корневого каталога}

RootSize Word {Количество элементов каталога}

DataLock Word {Начальный сектор данных}

end;

В этой структуре поля TypeD, AttrD и Cyls заполняются драйвером диска и соответствуют полям TypeDrv, Attrib и Cylindrs записи IOCTL_Info_Type (см. выше). Поле Media представляет собой дескриптор носителя.

Как уже отмечалось, при вызове IOCTL для дисков большой емкости поле IOCTL_Info_Type.Add. TotSecs содержит 0. В этом случае программа GetDiskInfo модуля F_Disk читает загрузочный сектор диска с помощью прерывания $25 и по его блоку BPB_Add_4_Type определяет полное количество секторов на логическом диске.


h0084.htm

84 Глава 3

Поле FAT16 определяет тип FAT: если это поле содержит значение TRUE, FAT состоит из 16—битных элементов, в противном случае — из 12-битных. Для контроля типа FAT в модуле используется рекомендуемая в MS-DOS проверка: если общее количество кластеров на диске превышает емкость 12-разрядного двоичного числа, т.е. больше 4096, значит FAT использует 16—разрядные элементы, в противном случае — 12-разрядные.

Значение поля RootLock вычисляется по формуле:

RootLock = FATLock + FATCi-it"" FAT Size а поля DataLock — по формуле

DataLock = (RootLock + RootSize*32) div 16+2

При обращениям ко всем процедурам и функциям модуля номер диска соответствует принятому в IOCTL порядку нумерации: 0 — диск А:, 1 — диск В:, 2 — диск С: и т.д. Исключением является вызов процедур GetAbs5ector и SetAbsSector, в которых номер диска соответствует обращению к прерыванию $13: 0 — диск А:, 1 — диск В:, $80 — 1—й ЖД, $81 - 2-й ЖД.

Процедура GetListDisk. Формирует связанный список дисковых описателей. Заголовок:

Procedure GetListDisk(var List: PListDisk);

Список определяется такой структурой:

type

{Список описателей диска}

PListDisk'= •^TListDisk;

TListDisk = record

Disklnfo: TDisk; (Описатель диска} NextDisk: PListDisk {Ссылка на следующий}

end;

Поскольку параметры ГД могут меняться от дискеты к дискете, информация о них не заносится в список. В модуле предусмотрена следующая глобальная переменная:

const

Disks: PListDisk = NIL.

Полезно перед самым первым обращением к подпрограммам модуля F_Disk сформировать список таким образом:

GetListDisk(Disks).

После этого обращение к любому жесткому диску не будет приводить к обязательному чтению его загрузочного сектора с целью получения нужной информации.


h0085.htm

Работа с диском на физическом уровне 85

Процедура FreeListDisk. С помощью этой процедуры из динамической памяти удаляется связанный список дисковых описателей, ранее созданный процедурой GetListDisk. Заголовок:

Procedure FreeListDisk(var List: PListDisk) ;

Функция ChanqeDiskette. Возвращает логический признак, указывающий, изменялось ли положение запора на приводе гибкого диска с момента последней операции чтения/записи (True — менялось). Эта информация сохраняется контроллером ГД и возвращается функцией 22 прерывания $13. Заголовок функции:

Function ChangeDiskette(Disk: Byte): Boolean;

Процедура GetAbsSector. Осуществляет чтение содержимого нужного физического сектора диска. Заголовок:

Procedure GetAbsSector(Disk,Head: Byte; CSec: Word;

var Buffer).

Параметры вызова функции соответствуют параметрам обращения к прерыванию $13: Disk — номер физического диска (0 = 1—й ГД, 1 = 2—й ГД, $80 = 1-й ЖД, $81 = 2-й ЖД); Head — номер головки (поверхности); нумерация начинается с нуля; CSec — номер цилиндра и сектора в виде 16—разрядного упакованного слова (нумерация цилиндров начинается с нуля, а секторов — с единицы); Buffer — переменная длиной 512 байт, в которую помещается содержимое прочитанного сектора.

Эта процедура использует прерывание BIOS $13. Она игнорирует логические разделы ЖД.

Функция GetCluster. Возвращает номер кластера для указанного номера сектора. Заголовок:

Function GetCluster (Disk: Byte; Sector: Word): Word.

Здесь Disk — номер диска; Sector — номер сектора.

Функция возвращает значение 0, если задан неверный номер сектора (меньше номера первого сектора архивной области диска или больше максимально возможного для данного диска).

Функция GetDefaultDrv. Возвращает номер диска, который установлен в ДОС как диск по умолчанию (текущий диск). Заголовок:

Function GetDefaultDrv: Byte.

Процедура GetDirItem. Возвращает элемент каталога для указанного файла. Заголовок:

Function GetDirItem(FileName: String; var Item: Dir_Type).

Здесь FileName — строковое выражение, содержащее имя файла (можно задавать имя с предшествующим ему маршрутом поиска); Item —


h0086.htm

86 Глава 3

переменная типа Dir_Type, в которой возвращается соответствующий элемент каталога.

Если не найден каталог, содержащий заданный файлг в переменной Disk_Error устанавливается значение TRUE, а в переменной Disk_Status — значение $FFFF (65535) .

Процедура GetDirSector. Возвращает номер сектора, в котором начинается указанный каталог, или 0, если каталог не найден. Заголовок:

Procedure GetDirSector (Path: String; var Disk: Byte;

var Dirs, DirSize: Word).

Здесь Path — выражение строкового типа, в котором указывается полный путь к каталогу; можно задать пустую строку (т.е. строку нулевой длины) для ссылки на текущий каталог; Disk — переменная типа Byte, в которой возвращается номер диска; DirS — переменная типа Word, возвращает 0, если каталог не найден, или номер сектора, в котором начинается каталог; DirSize — переменная типа Word, возвращает количество элементов каталога.

Процедура GetDiskInfo. Возвращает информацию о диске. Заголовок:

Procedure GetDiskInfo(Disk: Byte; var Info: TDisk).

Здесь Disk — номер диска; Info — переменная типа TDisk, в которой возвращается информация о диске.

При каждом обращении к этой функции, а к ней обращаются многие другие подпрограммы модуля, вначале проверяется связанный список, ассоциированный с глобальной переменной Disks: если этот список пуст или в нем не содержится сведений о нужном диске, осуществляется общий вызов IOCTL с требованием построить ВРВ, по результатам которого и формируется переменная Info. Таким образом, для ускорения доступа к диску полезно вначале сформировать процедурой GetListDisk связанный список дисковых описателей и поместить начало этого списка в переменную Disks.

функция GetDiskNumber. Возвращает номер логического диска по указанной букве его имени. Заголовок:

Function GetDiskNumber(Name: Char): Byte.

Здесь Name — имя диска (А, В, С и т.д.).

функция возвращает значение 255 ($FF), если указано недопустимое имя (если Name не принадлежит множеству 'A'..'Z или задает имя несуществующего логического диска).

Функция GetFATItem. Возвращает содержимое нужного элемента таблицы распределения файлов. Заголовок:

Procedure GetFATItem(Disk: Byte; Item: Word): Word. Здесь Disk — номер диска; Item — номер элемента FAT.


h0087.htm

В реализации этой функции учитывается то обстоятельство, что FAT может быть одного из двух типов: с 12—битными и 16—битными элементами. В первом случае под каждую пару смежных элементов выделяется три байта таблицы, во втором каждому элементу отводится два байта. Для определения типа FAT используется следующая проверка: если общее количество кластеров больше 4080, FAT содержит 16-битные элементы, иначе — 12—битные.

В случае 12-битной ГАГ значение, возвращаемое функцией CctFATtem, приводится к 16-битному формату: если элемент FAT имеет значение больше, чем $FFO, к этому значению прибавляется код $FOOO. Это связано с тем, что 16 старших значений элементов FAT ($FFFO. . .$FFFF для 16-битной и $FFO. . .$FFF для 12-битной FAT} используются ДОС для специальных целей — для указания конца цепочки FAT (коды $FF8. . ,$FFF для 12-битной и $FFF8. . ,$FFFF для 16—битной FAT), сбойных кластеров (коды $FF7 и $FFF7) и резервных кластеров (коды $FFO...$FF6 и $FFFO. . .$FFF6).

Процедура GetIOCTLInfo. Реализует общий вызов IOCTL в формате функции $60 (дать информацию об устройстве). Заголовок:

Procedure GetIOCTLInfo(Disk: Byte; var Info: IOCTL_Type).

Здесь Disk — номер диска; Info — Переменная типа IOCTL__Type, в которой возвращается информация о диске.

Эта процедура используется для построения ВРВ при обращении к процедуре GetDiskInfo.

Процедура GetMasterBoot. Используется для доступа к главному загрузочному сектору, что может оказаться полезным в программах защиты от компьютерных вирусов (см. гл.6). Заголовок:

Procedure GetMasterBoot(var Buf).

Здесь Buf — любая переменная длиной не менее 512 байт; в эту переменную помещается содержимое главного загрузочного сектора.

Главный (системный) загрузчик всегда располагается на первом ЖД (MS-DOS может обсуживать один или два жестких диска) в самом первом секторе нулевой дорожки. Доступ к этому сектору можно получить только с помощью прерывания $13. Доступ к остальным частям любого диска реализуется функциями ReadSector/WriteSector (см. ниже).

Функция GetMaxDrv. Возвращает общее количество логических дисков минус 1, т.е. максимально возможный номер диска. Заголовок:

Function GetMaxDrv: Byte.

Для определения количества дисков используется функция $ОЕ ДОС (установка диска по умолчанию), которая в регистре AL возвращает требуемое значение. Предварительно с помощью функции $19 программа получает номер текущего диска (диска по умолчанию), поэтому обращение к процедуре не меняет настройку ДОС.


h0088.htm

88 Глава 3

Функция GetSector. Преобразует номер кластера в номер сектора для указанного диска. Заголовок:

Function GetSector(Disk: Byte; Cluster: Word): Word.

Здесь Disk — номер диска; Cluster — номер кластера.

Функция возвращает значение $FFFF (65535), если задан неверный номер кластера (меньше 2 или больше MaxClus] или несуществующий диск.

Функция PackCylSec. Преобразует номер сектора и номер цилиндра в формат слова, используемого при обращении к функциям прерывания $13. Заголовок:

Function PackCylSec(Cyl,Sec: Word): Word. Здесь Cyl — номер цилиндра; Sec — номер сектора.

Процедура ReadSector. Осуществляет чтение одного или нескольких последовательных секторов с дискового носителя в оперативную память. Заголовок:

Procedure ReadSector (Disk: Byte; Sector, Count: Word;

var Buffer).

Здесь Disk — номер диска; Sector — номер дискового сектора, с которого начинается чтение информации; Count — количество читаемых секторов; Buffer — переменная любого типа размером не менее Counf'512 байт, в которую будет записана прочитанная информация.

В процессе работы процедура никак не контролирует истинного размера переменной Buffer, поэтому обращение к процедуре с переменной недостаточного размера может привести к непредсказуемым результатам.

В процедуре предусмотрена работа с дисками большой емкости.

Процедура SetAbsSector. Реализует запись на диск сектора по его абсолютному номеру с помощью прерывания $13. Заголовок:

Procedure SetAbsSector (Disk, Head: Byte; CSec: Word;

var Buffer).

Здесь Disk — номер физического диска (0 = 1 — и ГД, 1 = 2 — и ГД, $ 8 О = 1—й ЖД, $81 = 2—и ЖД); Head — номер головки (поверхности), нумерация начинается с нуля; С5ес — номер цилиндра и сектора в виде 16—разрядного упакованного слова (нумерация цилиндров начинается с нуля, а секторов — с единицы); Buffer — переменная длиной 512 байт, содержимое которой будет записано на диск.

Процедура SetDefaultDrv. Устанавливает указанный диск в качестве текущего (умалчиваемого) диска. Заголовок:

Procedure SetDefaultDrv(Disk: Byte). Здесь Disk — номер диска.


h0089.htm

Работа с диском на физическом уровне_______ 89

Процедура Set FAT Item. Записывает нужное значение в таблицу FAT и во все ее (таблицы) копии. Заголовок:

procedure SetFATItem(Disk: Byte; Cluster,Item: Word).

Здесь Disk — номер диска; Cluster — номер элемента FAT; Item — новое значение элемента.

Использование этой процедуры требует предельной осторожности, т.к. ошибочное изменение состояния FAT может привести к катастрофическим последствиям.

Как уже говорилось, на диске создается несколько следующих друг за другом копий FAT. Это обстоятельство приходится учитывать при записи скорректированного состояния FAT на диск в случае, если FAT использует 12-битные элементы. Вызвано это тем, что в целях уменьшения требуемой памяти и упрощения алгоритма в процедуре считывается не вся FAT, а лишь та тройка секторов, в которой находится изменяемый элемент (три смежных сектора гарантируют цикличность изменения адресов FAT — в одном 512—байтном секторе сохраняется информация о 2*512/3 = 341^3 12—разрядных элементах FAT). После коррекции копии FAT в памяти ее нужно записать на диск, предварительно исключив из записи те секторы, которые, возможно, не принадлежат первой копии FAT. Если этого не сделать, то при изменении последних элементов таблицы может быть испорчен корневой каталог.

Процедура SetMasterBoot. Записывает новое значение главного (системного) загрузчика. Заголовок:

Procedure SetMasterBoot(var Buf).

Здесь Buf — произвольная переменная; первые 512 байт этой переменной записываются в первый сектор нулевой дорожки первого жесткого диска.

Эта процедура может пригодиться в программах защиты от компьютерных вирусов (см. гл.6). Я настоятельно рекомендую не экспериментировать с процедурой SetMasterBoot, т.к. это может привести к разрушению системного загрузчика и Ваш ПК перестанет нормально функционировать.

Процедура UnpackCylSec. Преобразует упакованный формат ци— линдр/сектор, используемый при обращениях к прерыванию $13, к двум 16—разрядным словам, т.е. эта процедура осуществляет обратные действия по сравнению с функцией PackCylSec. Заголовок:

Procedure UnpackCylSec(CSec: Word; var Cyl,Sec: Word).

Здесь CSec — упакованный формат цилиндр/сектор; Cyl — номер цилиндра; Sec — номер сектора.

Процедура WriteSector. Записывает содержимое переменной любого типа в один или несколько смежных секторов. Заголовок:

Procedure WriteSector (Disk: Byte; Sector, Count: Word;

var Buffer);


h0090.htm

Здесь Disk — номер диска; Sector — номер дискового сектора, с которого начинается запись информации; Count — количество записываемых секторов; Buffer ~ переменная любого типа, содержимое которой требуется записать на диск.

Как и в случае использования процедуры SetFATItem, требуется тщательно проверить параметры обращения к этой процедуре перед запуском программы на счет. Запись в ошибочно указанный сектор может привести к непоправимым последствиям.

3.3.2. Тестовая программа

В следующей программе иллюстрируется применение некоторых из содержащихся в модуле F_Disk подпрограмм. Программа запрашивает имя любого уже существующего на диске текстового файла и осуществляет вывод его содержимого на экран дисплея.

Uses DOS,F_Disk;

var

Name: string;

Text: array [1..512] of Char;

k,j : Word;

N : Word;

DI : TDisk;

Item: Dir Type;

Disk: Byte;

Sec : Word;

begin

GetListDisk(Disks); {Формируем список дисков} repeat

Write('Введите имя файла '+

'(или нажмите Enter для выхода): ');

ReadLn(Name);

if Name <> '' then begin

Name := FExpand(Name); {Полное имя файла} Disk := GetDiskNumber(Name[1]);

GetDiskInfo(Disk,DI) ;

GetDirItem(Name,Item); /Элемент каталога} if not Disk_Error then with Item do begi-n

Sec := GetSector(Disk,FirstC); {Номер 1-го

сектора файла} j := 0; {Количество прочитанных секторов} if not Disk_Error then

repeat {Цикл печати файла} ReadSector(Disk,Sec,1,Text; ;

if Size < 512 then N := Size

else N :° 512;


h0091.htm

for k := 1 to N do

Write(Text[k]) ;

dec(Size,M); (Size - нераспечатанный

остаток файла} inc(j) ;

if j < DI.CXusSize then

inc(Sec) else begin j := 0;

FirstC := GetFATItem(Disk, PirstC) Sec := GetSector(Disk,FirstC) end until Size = 0 else

WriteLn('Ошибка чтения файла') end else

WriteLn('Ошибка поиска файла') end until Name = '';

FreeListDisk(Disks) {Удаляем связанный список} end.


h0092.htm

Глава 4

РАБОТА С МЫШЬЮ

Устройство ввода типа «мышь» (далее просто мышь) значительно упрощает взаимодействие пользователя с интерактивной (диалоговой) программой.

В Турбо Паскале не предусмотрены стандартные средства работы с мышью. В этой главе описывается модуль F_Mouse, который даст Вам возможность ввести в программу элементы взаимодействия с пользователем с помощью этого устройства.

4.1. ВЗАИМОДЕЙСТВИЕ С ДРАЙВЕРОМ МЫШИ

Большинство аппаратных устройств, входящих в состав ПК, комплектуется драйверами — особыми программами, с помощью которых реализуется взаимодействие с аппаратурой на физическом уровне. Не является исключением и мышь: разработанный д^я нее фирмой Microsoft драйвер берет на себя всю черновую работу, связанную с обслуживанием устройства, предоставляя пользователю простые и удобные средства взаимодействия, с ним. Драйвер Microsoft для мыши является своеобразным стандартом для драйверов этого типа. Ниже рассматриваются его функции.

Драйвер представляет собой достаточно сложную программу, состоящую из двух основных частей — монитора мыши и монитора экрана.

Перемещение мыши измеряется в шагах. Шаг — это минимальное расстояние, регистрируемое датчиками мыши. Обычно разрешающая способность датчиков соответствует 8 шагам на миллиметр, т.е. величина шага составляет 0.125 мм. Существуют устройства, имеющие более высокую точность — до 16 шагов на миллиметр. Монитор мыши подсчитывает число шагов в каждом направлении и преобразует их в эквивалентное количество элементов изображения виртуального экрана. Элементы изображения определяются из стандартного текстового режима 80х25 путем умножения координат на 8, т.е. виртуальный экран — это максимальное разрешение CGA—адаптера в графическом режиме — 640х200. Координаты мыши могут выходить за пределы виртуального экрана, если реальный адаптер имеет более высокое разрешение.

Монитор экрана следит за соответствием положения указателя мыши на физическом экране текущим виртуальным координатам, полученным от монитора мыши. Поскольку дисплей может работать в различных режимах (текстовом или графическом), монитор экрана опрашивает текущий режим адаптера с помощью прерывания $10 и автоматически меняет изображение указателя при смене режимов. При быстрых перемещениях мыши монитор экрана может не успевать менять положение указателя на экране, поэтому драйвер следит также за скоростью смещения. Если эта скорость превосходит некоторую пороговую величину, драйвер удваивает число шагов, соответствующих одному и тому же линейному перемещению


h0093.htm

мыши, в результате указатель начинает смещаться по экрану с удвоенной скоростью.

Создаваемое драйвером стандартное изображение указателя на экране соответствует инверсному прямоугольнику в текстовом режиме (т.е. прямоугольнику, цвет которого определяется операцией NOT, примененной к байту атрибутов текущего символа) и направленной справа-налево и снизу—вверх стрелкой — в графическом режиме. Этот указатель может меняться по требованию программы.

Доступ к функциям драйвера мыши реализуется с помощью прерывания $33 MS-DOS. В табл.4.1 описываются функции этого прерывания так, как они реализованы в драйвере мыши фирмы Microsoft.

Таблица 4.1

Функции драйвера мыши

Функция | Назначение
$00 | Сбросить драйвер
$01 | Показать указатель мыши
$02 | Убрать указатель мыши
$03 | Получить текущие координаты мыши и состояние ее кнопок
$04 | Переместить указатель в новое положение
$05 | Получить информацию о нажатии кнопки
$06 | Получить информацию об отпускании кнопки
$07 | Установить область перемещения указателя по горизонтали
$08 | Установить область перемещения указателя по вертикали
$09 | Задать форму указателя для графического режима
$ОА | Задать форму указателя для текстового режима
$ОВ | Получить счетчик шагов перемещения
$ОС | Задать условия вызова программы пользователя
$OD | Включить эмуляцию светового пера
$OE | Выключить эмуляцию светового пера
$OF | Установить отношение числа шагов на единицу виртуального экрана
$13 | Установить порог удвоения скорости смещения указателя мыши
$14 | Заменить процедуру пользователя
$15 | Получить размер буфера, необходимого для сохранения состояния драйвера
$16 | Сохранить текущее состояние драйвера
$17 | Восстановить состояние драйвера
$1D | Задать видеостраницу для отображения указателя
$1Е | Получить номер видеостраницы, в которой отображается указатель

Сбросить драйвер

Вход: АХ = О

Выход: АХ — состояние мыши и драйвера:

$ О О О О — мышь или драйвер не установлены;

$ FFFF — сброс осуществлен, драйвер и мышь установлены;

ВХ — количество кнопок у мыши:

О — число кнопок отлично от двух;

2 — две кнопки;

3 — три кнопки.

После обращения к функции $00 все параметры драйвера принимают значения по умолчанию: устанавливается стандартная форма указателя


h0094.htm

(прямоугольник или стрелка — в зависимости от текущего режима работы дисплея); указатель помещается в центр экрана и его изображение гасится;

с указателем связывается видеостраница 0; драйвер автоматически определяет текущее разрешение экрана и устанавливает максимально возможную область перемещения указателя. Обычно эта функция вызывается после смены режима работы дисплея.

Показать указатель мыши

Вход: АХ = 1.

Функция $01 показывает указатель на экране. Поскольку драйвер отслеживает перемещения мыши и при погашенном указателе, последний может появиться в любом месте экрана — не обязательно там, где был погашен.

Убрать указатель мыши

Вход: АХ = 2.

Функция $02 гасит указатель мыши. Эту функцию следует вызывать перед каждым использованием прямого доступа к видеопамяти. Дело в том, что драйвер запоминает состояние видеопамяти перед выводом указателя на экран и восстанавливает это состояние при перемещении указателя в новое место. Если перед непосредственной записью данных в видеопамять не погасить указатель, драйвер выведет на экран неверный символ при смещении мыши. Точно так же при непосредственном считывании данных из видеопамяти можно считать указатель мыши вместо соответствующего символа.

Следует иметь в виду, что драйвер наращивает на единицу внутренний счетчик всякий раз, когда вызывается функция $02, и уменьшает этот счетчик при вызове функции $01. Указатель становится виден только в том случае, когда этот счетчик равен 0, поэтому вызов функций $01 и $02 может не привести к желаемым результатам, если нарушено соответствие вызовов.

Получить текущие координаты мыши и состояние ее кнопок

Вход: АХ = 3. Выход: ВХ — байт состояния кнопок:

биты 0 — левая кнопка;

1 — правая кнопка;

2 — средняя кнопка;

(1 соответствует нажатой кнопке, 0 — отпущенной);

СХ — горизонтальная координата мыши;

DX — вертикальная координата.

Функция $03 дает исчерпывающую информацию о текущем состоянии мыши: состояние кнопок указывается битами регистра ВХ, в то время как в регистрах СХ и DX возвращаются текущие координаты указателя. Координаты указателя соответствуют виртуальному экрану. На практике они с о держа г положение координатной точки (пиксела) указателя в графи—


h0095.htm

ческом режиме или умноженные на 8 координаты в текстовом режиме (отсчет координат от 0). Таким образом, чтобы перевести виртуальные координаты в координаты позиция — колонка, нужно разделить полученные значения на 8 и добавить к ним по единице (текстовые координаты в Турбо Паскале отсчитываются от 1). Для графического режима такой пересчет обычно не нужен.

Переместить указатель в новое положение

Вход: АХ = 4;

CX,DX — требуемые виртуальные координаты (X,Y) мыши. Функция $04 устанавливает указатель мыши в заданную точку экрана. функция получает виртуальные координаты, поэтому при обращении к ней координаты текстового экрана должны уменьшаться на единицу и умножаться на 8. Виртуальные координаты требуемого положения указателя должны находиться в прямоугольнике, ограниченном обращениями к функциям $07 и $08.

Получить информацию о нажатии/отпускании кнопки

Вход: АХ = 5 — получить информацию о нажатии;

= 6 — получить информацию об отпускании;

ВХ — идентификатор нужной кнопки

(биты О, 1, 2 выбирают соответственно

левую, правую и среднюю кнопку). Выход:АХ — текущее состояние кнопок (см. ВХ в функции $03);

ВХ — количество нажатий (отпусканий) указанной кнопки

после последнего вызова функции $05 ($06);

CX,DX — виртуальные координаты мыши (X,Y), соответствующие

последнему нажатию (отпусканию) кнопки. Функции $05 и $06 дают информацию о том, сколько раз нажималась (отпускалась) нужная кнопка мыши, какая (какие) кнопки нажаты в данный момент и координаты той точки, где указанная кнопка нажималась (отпускалась) в последний раз. После обращения к этим функциям сбрасываются внутренние счетчики драйвера, поэтому полученная информация соответствует интервалу времени, прошедшему от момента последнего вызова соответствующей функции.

Установить область перемещения указателя по горизонтали (вертикали)

Вход: АХ = 7 — по горизонтали;

= 8 — по вертикали;

СХ — минимальная координата;

DX — максимальная координата.

Функции $07 и $08 определяют границы прямоугольной области соответственно по горизонтали и вертикали, в пределах которой может перемещаться указатель мыши. После вызова функции курсор автоматически помещается в указанную область, если он находится вне ее. Если


h0096.htm

при обращении к функциям минимальная граница больше максимальной, границы меняются местами. Границы, задаваемые этими функциями, могут превышать реальное разрешение экрана. В этом случае указатель будет исчезать, если виртуальные координаты мыши выходят за границы экрана.

Задать форму указателя для графического режима

Вход: АХ = 9

ВХ — положение координатной точки от левого края изображения;

СХ — положение координатной точки от верхнего края

изображения;

ES:DX — адрес битового поля [ES — сегментная часть адреса). Функция $09 определяет форму графического указателя. По умолчанию этот указатель имеет вид стрелки, ориентированной слева—направо и снизу вверх, причем координатная точка указателя соответствует острию стрелки. Программа может с помощью этой функции задать другую форму указателя. При обращении к функции регистры ES:DX должны содержать адрес 64—байтного массива, который трактуется следующим образом. Первые 16 двухбайтных слов рассматриваются как битовая маска 16х16, каждый бит которой маскирует пикселы экрана (эти байты называются маской экрана); вторые 16 слов — матрица 16х16 бит для формирования изображения указателя (маска изображения). Размер указателя на графическом экране всегда составляет 16х16 пиксел. При создании изображения драйвер предварительно получает информацию о 16х16 пикселах соответствующего места экрана и к каждому пикселу применяется операция AND с маской экрана, а затем к полученному результату — операция XOR с маской изображения. Например, если маска экрана содержит одни нули, на экране будет вырезан пустой прямоугольник 16х16 пиксел и в него без изменения помещается маска изображения — это вариант «непрозрачного» указателя. Наоборот, если маска экрана состоит из битовых единиц (слова со значением $FFFF), изображение указателя взаимодействует с экранным изображением в режиме XORPut («прозрачный» указатель). Расположение сформированного указателя относительно виртуальных координат мыши определяется смещением координатной точки относительно левого и верхнего краев маски экрана. Если, например, ВХ = СХ = 0, координатная точка соответствует левому верхнему углу маски, поэтому изображение указателя размещается правее и ниже виртуальных координат указателя, если ВХ == СХ = 8, координатная точка соответствует центру изображения.

Задать форму указателя для текстового режима

Вход: АХ == $ОА;

ВХ — флаг указателя:

О — программное управление формой;

1 — аппаратное управление формой;

СХ — маска экрана для ВХ=0 или верхняя строка развертки дляВХ=1;

DX — маска указателя для ВХ=0 или нижняя строка развертки


h0097.htm

дляВХ=1.

Функция $ОА управляет формой указателя в текстовом режиме. При обращении к ней программа имеет две возможности: определить форму программным способом (ВХ^О) или аппаратным (BX=lj. Аппаратная форма указателя соответствует стандартному мигающему курсору. Замечу, что сам текстовый курсор в этом случае не меняет своего положения, но становится невидимым, так как мигающее изображение соответствует указателю мыши (если указатель погасить, курсор вновь станет виден). Если выбрана аппаратная форма, регистры СХ и DX содержат номера строк развертки, ограничивающих изображение. Эти координаты задаются в диапазоне О...7. Если СХ=0 и DX=7, изображение представляет собой мигающий прямоугольник максимальных размеров; стандартный курсор задается значениями СХ=6 и DX=7. В случае программного управления формой в СХ и DX должны содержаться маски экрана (СХ) и символа (DX). Истинное изображение указателя в этом случае определяется следующим образом: читается слово из видеопамяти, куда должен будет помещен указатель; к этому слову применяется операция AND с маской экрана, а к результату — операция XOR с маской символа; окончательный результат помещается в видеопамять.

Получить счетчик шагов перемещения

Вход: АХ = $ОВ.

Выход: CX,DX — количество шагов по горизонтали (СХ) и

вертикали (DX) после последнего вызова функции $ОВ.

С помощью функции $ОВ можно получить суммарное количество шагов, на которые смещалась мышь по каждой координате за время, прошедшее с момента последнего вызова функции. Положительные значения соответствуют смещениям вправо и вниз, отрицательные — влево и вверх. Обращение к функции сбрасывает внутренние счетчики драйвера.

Задать условия вызова программы пользователя

Вход: АХ = $ОС;

СХ — условия вызова; определяются единичными значениями разрядов регистра при следующих событиях:

биты 0 — мышь перемешается;

1 — нажимается левая кнопка;

2 — отпускается левая кнопка;

3 — нажимается правая кнопка;

4 — отпускается правая кнопка;

5 — нажимается средняя кнопка;

6 — отпускается средняя кнопка;

ES:DX — адрес программы пользователя (ES — сегмент). Функция $ОС определяет условия вызова внешней процедуры, с помощью которой программа может реагировать на манипуляции с мышью в момент, когда происходит то или иное событие. Драйвер мыши постоянно находится в оперативной памяти ПК и получает управление при каждом изменении состояния мыши. функция $ОС сообщает драйверу адрес

4—1412


h0098.htm

процедуры и условия ее вызова: в момент возникновения указанного события драйвер вызывает эту процедуру, которая должна транслироваться в расчете на дальнюю модель памяти (с ключом FAR]. При вызове процедуры в регистрах центрального процессора содержатся следующие данные:

AX — маска условий (то же слово, которое передается функции $ОС в регистре СХ);

ВХ — состояние кнопок, как это определено для функции $03;

CX,DX — виртуальные координаты курсора;

DI.SI — число шагов мыши по горизонтали и вертикали;

DS — сегмент данных драйвера мыши.

Программа может использовать эти регистры по своему усмотрению. Работа программы завершается командой FAR RET.

Замечу, что при вызове программы пользователя регистр DS содержит сегмент данных драйвера мыши. Этот сегмент никогда не соответствует сегменту данных Турбо Паскалевой программы, поэтому процедура пользователя должна реализовываться с помощью встроенного ассемблера (см. процедуру MouseHandler в модуле F_Mouse).

Включить (выключить) эмуляцию светового пера

Вход: AX = $OD — включить;

= $ОЕ — выключить

С помощью функции $OD включается, а функцией $ОЕ выключается режим эмуляции светового пера. В языке программирования MS Basic предусмотрен оператор PEN, с помощью которого можно получить доступ к световому перу. Эмуляция светового пера включается драйвером по умолчанию. Если в ПК есть это устройство, режим эмуляции необходимо отключить.

Установить отношение числа шагов на единицу виртуального экрана

Вход: AX = $OF;

CX,DX — количество сотых долей дюйма по горизонтали (СХ) и вертикали (DX) на 8 единиц виртуального экрана (на 8 пиксел).

Функция $OF позволяет задать масштабные коэффициенты пересчета перемещения мыши в виртуальные координаты экрана. По умолчанию драйвер устанавливает значения этих коэффициентов, равные 8, т.е. каждый пиксел экрана соответствует 8 сотым долям дюйма (2,032 мм) линейного перемещения мыши. Чем большее значение задается этими коэффициентами, тем меньше смещается на экране указатель мыши при одном и том же ее перемещении.

Установить порог удвоения скорости смещения указателя мыши

Вход: АХ = $13;

DX — новое значение порога удвоения скорости.


h0099.htm

Заменить процедуру пользователя

Вход: АХ •= $14.

Остальные регистры такие же, как и при вызове функции $ОС. Выход: СХ — условия вызова ранее установленной процедуры;

ES'.DX — адрес этой процедуры.

При переходе из одного режима работы программы в другой бывает необходимо запомнить текущее состояние драйвера, чтобы при возврате в старый режим восстановить это состояние. Эти действия реализуются функциями $14, $15, $16 и $17. Функция $14 реализует те же действия, что и функция $ОС, т.е. задает адрес и условия вызова процедуры пользователя, но при выходе из нее в регистрах СХ и ES'.DX содержатся условия вызова и адрес ранее установленной процедуры.

Получить размер буфера, необходимого для сохранения состояния драйвера

Вход: АХ = $15;

ВХ == 0.

Выход: ВХ — размер буфера в байтах. См. пояснения к функции $14.

Сохранить текущее ^.состояние драйвера

Вход: АХ = $16;

ES-.DX — адрес буфера (?5 — сегмент). См. пояснения к функции $14.

Восстановить состояние драйвера

Вход: АХ = $17;

ES'.DX — адрес буфера (ES — сегмент). См. пояснения к функции $14.

Задать видеостраницу для отображения указателя

Вход: АХ = $1D;

ВХ — номер видеостраницы (от 0). См. пояснения к функции $1Е.

Получить номер видеостраницы, в которой отображается указатель

Вход: АХ = $1Е. Выход: ВХ — номер видеостраницы (от 0).

При работе с несколькими видеостраницами могут оказаться полезными функции $1D и $1Е. С помощью первой выбирается нужная видеостраница, в которой будет отображаться указатель мыши, вторая позволяет определить номер страницы с указателем.


h0100.htm

100 Глава 4

4.2. МОДУЛЬ F_MOUSE

Все подпрограммы модуля F_Mouse (их около сорока) в функциональном отношении делятся на несколько групп — подпрограммы инициации мыши, обслуживания координат и т.д. Основную их часть составляют подпрограммы низкого уровня, реализующие интерфейс между описанными в п.4.1 функциями драйвера мыши и программой на Турбо Паскале.

В модуль включены также процедуры и функции, облегчающие разработку программ, рассчитанных одновременно на работу и с мышью, и с клавиатурой. Для их использования программист должен определить так называемые элементы выбора — прямоугольные участки экрана, выбор которых с помощью мыши. порождает генерацию расширенных кодов заранее обусловленных клавиш.

Полный текст модуля приведен в прил.П5.

4.2.1. Глобальные константы, типы и переменные

Для описания элементов выбора, используемых в подпрограммах эмуляции клавиатуры, в модуле определен следующий тип:

type

MouseItemType = record

X1,Y1,X2,Y2: Integer; {Координаты области)

Butt: Word; {Условие выбора}

Key : Word {Расширенный код клавиши}

end;

Условием выбора является нажатие одной из кнопок мыши в момент, когда указатель находится в границах элемента. Это условие кодируется в поле Butt как признак нужной кнопки.

Для указания процедуры, получающей управление непосредственно от драйвера в момент наступления нужного события, определен такой процедурный тип:

type

MouseHandlerType = Procedure (Mask,Buttons,X,Y, DX,DY: Integer);

Формальным параметрам процедуры придается следующий смысл:

Mask — маска вызова процедуры;

Buttons — состояние кнопок мыши;

X,Y — горизонтальная и вертикальная координаты указателя;

DX, DY — полное количество шагов перемещения по горизонтали (DX) и вертикали (DY).

Д^я указания той или иной кнопки могут использоваться следующие константы:

const

LeftButton = 1; (Левая кнопка} RightButton =2; {Правая кнопка}


h0101.htm

CenterButton =4; {Средняя кнопка} AnyButton =7; {Любая кнопка}

Пересчет виртуальных координат в текстовые и обратно осуществляется С помощью двух масштабных коэффициентов:

const

TextRatioX: Byte = 8; {Для колонок} TextRatioY: Byte = 8; (Для строк}

Вы должны изменить эти коэффициенты, если используете в графическом режиме шрифт, размеры которого не соответствуют 8 пикселам по горизонтали и вертикали: в TextRatioX следует поместить ширину символов в пикселах, а в TextRatioY — высоту.

4.2.2. Инициация мыши

Функция IsMouse. Возвращает True, если программе доступна мышь. Заголовок:

Function IsMouse: Boolean;

Для проверки доступности мыши функция контролирует вектор прерывания $33 — он не должен быть нулевым. Затем она обращается к функции 3 драйвера (дать статус мыши) и контролирует изменение регистра ВХ. Замечу, что эти проверки осуществляются только в том случае, когда внутренняя переменная NButton, содержащая количество кнопок мыши, равна нулю. Если мышь оснащена двумя или тремя кнопками, в эту переменную помещается нужное число после первого же обращения к функции InitM.ov.se.

Функция InitMouse. Осуществляет сброс драйвера мыши. Заголовок:

Function InitMouse: Boolean;

После вызова этой функции указатель гасится и устанавливается в центр экрана, он приобретает стандартную форму, границы перемещения указателя расширяются на весь экран, для его отображения в текстовом режиме выбирается видеостраница 0 (основная). Если к этому моменту были определены элементы выбора, они сбрасываются.

Функция возвращает True после успешного вызова и False, если отсутствует драйвер мыши или к мыши нет физического доступа. Вызов функции должен предшествовать началу работы с мышью.

Процедура SetMousePaqe. Устанавливает видеостраницу, в которой будет отображаться указатель мыши. Заголовок:

Procedure SetMousePage(Page: Byte).

Здесь Page — номер устанавливаемой страницы (нумерация страниц начинается с нуля).


h0102.htm

Заметим, что при смене видеостраниц с помощью прерывания $10 драйвер мыши автоматически меняет страницу отображения, поэтому надобности в этой процедуре обычно не возникает.

Функция GetMousePaqe. Возвращает номер видеостраницы с указателем мыши. Заголовок:

Function GetMousePage: Byte.

Процедура SetStepToPixel. Устанавливает чувствительность мыши. Заголовок:

Procedure SetStepToPixel(Ног,Ver: Integer).

Здесь Ног — чувствительность по горизонтали, Ver — чувствительность по вертикали.

Чувствительность определяется как количество сотых долей дюйма (0,254 мм) перемещения мыши, приходящихся на каждый пиксел экрана. По умолчанию чувствительность соответствует 8 единицам по каждой оси (2,032 мм). Чем большее значение имеют параметры Ног и Ver, тем на меньшее расстояние переместится указатель при одном и том же смещении мыши.

Процедура GetStepToPixel. Возвращает текущую чувствительность мыши. Заголовок:

Procedure GetStepToPixel(var Ног,Ver: Integer);

После обращения к процедуре переменные Ног и Ver будут иметь значения, соответствующие сотым долям дюйма на каждый пиксел экрана.

4.2.3. Координаты

Функция MouseTextCooX. Возвращает текстовую координату положения указателя по горизонтали. Заголовок:

Function MouseTextCooX(X: Integer): Byte.

Здесь X — виртуальная координата мыши. Для пересчета используется коэффициент TextRatioX.

Функция MouseTextCooY. Возвращает текстовую координату положения указателя по вертикали. См. MouseTextCooX.

Функция MouseGraphCooX. Возвращает горизонтальную виртуальную координату по заданной текстовой. Заголовок:

Function MouseGraphCooX(X: Byte): Integer.

Здесь X — текстовая координата. Для пересчета используется коэффициент TextRatioX.

Функция MouseGraphCooY. Возвращает вертикальную виртуальную координату по заданной текстовой. См. MouseGraphCooX.


h0103.htm

Процедура MouseWhereXY. Возвращает текущие координаты указате — ля. Заголовок:

Procedure MouseWhereXY(var X,Y: Integer).

Здесь X,Y — переменные, в которых возвращаются текущие виртуальные координаты указателя.

Замечу, что координаты меняются при любом смещении мыши независимо от того, виден ли на экране указатель или нет.

Прсщедура MouseGotoXY. Перемещает указатель в заданную точку экрана. Заголовок:

Procedure MouseGotoXY(X,Y: Integer).

Здесь X, Y — виртуальные координаты требуемого положения указателя.

Функция MouseWhereX. Возвращает текущую горизонтальную текстовую координату указателя. Заголовок:

Function MouseWhereX: Byte.

Функция MouseWhereY. Возвращает текущую вертикальную текстовую координату указателя. Заголовок:

Function MouseWhereY: Byte.

функция MouseIn. Возвращает True, если указатель находится в заданном месте экрана. Заголовок:

Function MouseIn(Xl,Yl,X2,Y2): Boolean.

Здесь XI. „Y2 — виртуальные координаты, определяющие верхний левый (X1,Y1) и правый нижний (X2,Y2) углы прямоугольника, в котором должен находиться указатель.

4.2.4. Состояние кнопок

Функция NumButton. Возвращает количество кнопок у мыши. Заголовок:

Function NumButton: Byte.

Функция возвращает 2, если мышь имеет две кнопки, 3 — если три, и О во всех других случаях.

Процедура GetMouseState. Возвращает текущее состояние мыши. Заголовок:

Procedure GetMouseState(var Butt,X,Y: Integer).

Здесь Butt — признаки состояния кнопок; X,Y — текущие виртуальные координаты.


h0104.htm

В переменной Butt процедура возвращает информацию о текущем состоянии кнопок мыши. Для каждой кнопки в этом слове выделен один бит (О—и бит для левой, 1 — и бит для правой и 2 — и бит для средней; О—и бит соответствует младшему разряду). Если бит имеет единичное значение, кнопка нажата, в противном случае отпущена.

Функция MousePressed. Возвращает True, если нажата любая кнопка мыши. Заголовок:

Function MousePressed: Boolean.

Процедура MouseButtPressed. Возвращает информацию о нажатии кнопки мыши. Заголовок:

Procedure MouseButtPressed (Butt: Integer;

var Stat, Count, X, Y: Integer).

Здесь Butt — флаг выбора нужной кнопки; Stat — состояние кнопок;

Count — количество нажатий указанной кнопки с момента последнего вызова функции; X,Y — координаты, соответствующие последнему нажатию.

Процедура MouseButtReleased. Возвращает информацию об отпускании кнопки мыши. Заголовок:

Procedure MouseButtReleased (Butt: Integer;

var Stat, Count, X, Y: Integer).

Здесь Butt — флаг выбора нужной кнопки; Stat — состояние кнопок;

Count — количество отпусканий указанной кнопки с момента последнего вызова функции; Х,У — координаты, соответствующие последнему от— пусканию.

4.2.5. Окна

Процедура MouseWindo.w. Определяет область перемещения указателя. Заголовок:

Procedure MouseWindow(X1,Y1,X2,Y2: Integer).

Здесь XI. ..Y2 — виртуальные координаты левого верхнего (X1,Y1) и правого нижнего (X2,Y2) углов.

После вызова процедуры указатель скачком перемещается в указанную область, если перед этим он не находился в ней.

Процедура MouseScreen. Делает доступным для перемещений указателя весь экран. Заголовок:

Procedure MouseScreen.

В процедуре используется обращение к функции $F прерывания $10 для того, чтобы определить текущий видеорежим.


h0105.htm

Работа с мышью 105,

4.2.6. Форма указателя

Процедура ShowMouse. Показывает указатель мыши. Заголовок. Procedure ShowMouse.

Процедура HideMouse. Гасит указатель мыши. Заголовок:

Procedure HideMouse.

Как уже отмечалось, драйвер мыши ведет подсчет обращений к функциям 1 и 2 (показать/убрать указатель). Чтобы исключить неоднозначную реакцию, процедуры ShowMouse и HideMouse проверяют внутренний флаг Mouse Visible и осуществляют обращение к этим функциям только в том случае, когда это действительно необходимо. Если указатель уже виден на экране, игнорируется вызов ShowMouse, наоборот, если указатель погашен, игнорируется вызов HideMouse.

Следует заметить, что при работе со стандартными процедурами модуля Crt, а также при нормальном выводе на экран процедурами Write/WriteLn Турбо Паскаль организует прямой доступ к видеопамяти. Поэтому полезно использовать HideMouse перед любым изменением содержимого экрана.

Процедура MouseTextCursor. Определяет вид указателя для текстового режима. Заголовок:

Procedure MouseTextCursor(ScrMask,CurMask: Word).

Здесь ScrMask — маска экрана; CurMask — маска указателя. Напомню, что драйвер мыши формирует указатель следующим образом:

читается слово видеопамяти, содержащее символ и атрибуты нужной позиции экрана; к этому слову применяется операция AND с маской экрана, а к полученному результату — операция XOR с маской указателя. Таким образом, если ScrMask == 0, указатель имеет форму символа, содержащегося в младшем байте маски CurMask, а атрибуты указателя (цвет и признак мерцания) задаются страшим байтом этого слова.

Процедура MouseBlink. Определяет указатель в виде мигающего курсора. Заголовок:

Procedure MouseBlink(YUp,YDn: Byte);

Здесь YUp, YDn — номера верхней (YUp) и нижней (YDn) строк развертки.

После обращения к этой процедуре указатель мыши имеет вид мигающего курсора. Замечу, что сам текстовый курсор не меняет своего положения при перемещении мыши — драйвер «заимствует» его изображение для создания указателя. Параметры YUp и YDn определяют размер указателя: первый параметр задает номер верхней, а второй — нижней строк развертки, в пределах которых мигает курсор. Стандартный курсор соответствует YUp = 6 и YDn = 7, т.е. занимает две нижние строки (нумерация строк от 0 до 7). При YUp = 0 и YDn = 7 курсор занимает все знакоместо. Если при обращении YUp = $20, указатель не будет виден.


h0106.htm

Процедура MouseGraphCursor. Определяет вид указателя в графическом режиме. Заголовок:

Procedure MouseGraphCursor(var ScrCurMask; X,Y: Byte).

Здесь ScrCurMask — 64—байтный массив, определяющий маску экрана и маску указателя; X,Y — смещение координатной точки относительно левого верхнего угла изображения.

Массив ScrCurMask должен содержать две 32—байтных маски, которые трактуются следующим образом. При выводе указателя драйвер осуществляет операцию AND над участком экрана размером 16х16 пиксел и первой половиной массива (маской экрана); затем к результату применяется операция XOR с второй половиной ScrCurMask [с маской указателя). Полученное рассматривается как битовая маска 16х16 пиксел, которая выводится в нужное место экрана как указатель мыши. Если, например, первая половина массива ScrCurMask (маска экрана) состоит из одних нулей, изображение указателя, определяемое второй половиной массива (маска указателя), выводится следующим образом: каждое 16—разрядное слово маски рассматривается как образ 16 пиксел в одной из строк развертки; если слово имеет значащий разряд, соответствующий пиксел светится, если 0, не светится.

Параметры Х и Y определяют смещение «центра» указателя от верхнего левого угла изображения. Если Х = Y = 0, координатная точка мыши соответствует верхнему левому углу изображения, если Х = У == 8 — центру изображения и т.д.

4.2.7. Сохранение/восстановление состояния

Функция MouseBuffSize. Возвращает размер памяти (в байтах), необходимой для сохранения текущего состояния драйвера мыши. Заголовок:

Function MouseBuffSize: Word.

Процедура SaveMouse. Сохраняет текущее состояния драйвера мыши. Заголовок:

Procedure SaveMouse(var Buff).

Здесь Buff — переменная нужного размера, в которой будет сохранено текущее состояние драйвера (минимальный размер переменной возвращается функцией MouseBuffSize).

Процедура RestoreMouse. Восстанавливает состояние драйвера. Заголовок:

Procedure RestoreMouse(var Buff).

Здесь Buff — переменная, содержащая состояние драйвера, Предполагается, что к моменту вызова процедуры RestoreMouse состояние драйвера было сохранено в переменной Buff с помощью проце —

дуры SaveMouse.


h0107.htm

Работа с мышью 107

4.2.8. Эмуляция клавиатуры

В модуль F_Mouse включены процедуры и функции, облегчающие разработку программ, в которых диалог с пользователем реализуется как с использованием клавиатуры, так и с помощью мыши. Многие диалоговые программы используют различного рода указатели (опции), обеспечивающие выбор одного из нескольких возможных вариантов. В модуле такие элементы называются элементами выбора. Для задания элементов выбора предусмотрен следующий тип данных:

type

MouseItemType = record

X1,Y1,X2,Y2: Integer; /Текстовые координаты области} Butt: Word; {Условия вызова} Key : Word {Скан-код клавиши}

end;

Как нетрудно заметить, в этом типе предусмотрены поля для определения положения каждого из элементов выбора на экране (X1...Y2), а также условие выбора (Butt) и код той клавиши (Key), с помощью которой выбирается этот элемент. Предполагается, что пользователь (программист) сам создает на экране изображение диалогового элемента. После этого он обращается к процедуре SetMouseItem, вызов которой делает элементы «известными» для подпрограмм KeyOrMousePressed и ReadKeyOrM.ou.se.

Процедура SetMouseItem. Задает один или более элементов выбора. Заголовок:

Procedure SetMouseItem(BItem: Byte; var Items).

Здесь NItem — количество определяемых элементов; /ferns — массив из NIem элементов типа MouseItemType (описание типа см. в п.4.2.1).

Если к моменту обращения к этой процедуре уже был определен список элементов выбора, он безвозвратно теряется. Процедура копирует список элементов в динамическую память, поэтому последующее изменение списка без обращения к процедурам SetMouseItem/'AddMouseItem игнорируется.

Процедура AddMouseItem. Добавляет еще один элемент к списку элементов выбора. Заголовок:

Procedure AddMouseItem(Item: MouseItemType).

После обращения к процедуре старый список элементов выбора дополняется еще одним элементом.

Процедура ClearMouseItem. Очищает список элементов выбора. Заголовок:

Procedure ClearMouseItem.


h0108.htm

Процедура освобождает динамическую память, выделенную для списка элементов выбора, и присваивает внутренней переменной NMouseItem (количество элементов выбора) значение 0.

Функция KeyOrMousePressed. Возвращает True, если нажата любая клавиша или выбран один из элементов выбора. Заголовок:

Function KeyOrMousePressed: Boolean.

Функция ReadKeyOrMouse. Возвращает расширенный код нажатой клавиши или выбранного элемента выбора. Заголовок:

Function ReadKeyOrMouse: Char.

При обращении к функции вначале проверяется состояние клавиатуры:

если к этому моменту была нажата любая клавиша, функция возвращает расширенный код этой клавиши точно так же, как это делает стандартная функция ReadKey. Если ни одна клавиша не была нажата, проверяется состояние мыши: когда указатель находится в поле одного из элементов и обеспечено условие выбора этого элемента (например, нажата нужная кнопка мыши), функция возвращает расширенный код, связанный с этим элементом. Если ни одно из условий не выполнено, т.е. не нажата клавиша или не выбран элемент, функция повторяет опрос клавиатуры и состояния мыши.

В поле Key нужного элемента выбора пользователь должен поместить расширенный код клавиши, связанной с этим элементом выбора. Если младший байт этого слова равен нулю, функция устанавливает внутренний флаг DoubleChar в значение True, что обеспечивает выдачу второго байта этого слова при повторном обращении к функции. Например, если Вы хотите, чтобы с некоторым элементом была связана клавиша F1, Вам необходимо поместить в младший байт поля Key значение 0, а в старший — значение 59. Тогда при первом обращении к функции программа получит значение #0, а при втором — #59, что и представляет собой расширенный код клавиши F1.

4.2.9. Обработка событий от мыши

В интерфейсной части модуля F_Mouse определены три процедуры, с помощью которых пользователь может установить собственную процедуру обработки событий от мыши, изменить эту процедуру на новую или сбросить ее. Кроме того, в теле модуля имеется внутренняя процедура MouseHandler, реализующая интерфейс между драйвером мыши и процедурой пользователя. Эта процедура является фактическим обработчиком событий от мыши: при возникновении условий вызова драйвер мыши передает управление именно ей. Процедура MouseHandler проверяет корректность вызова (ненулевое значение адреса процедуры пользователя) и обеспечивает нужный формат вызова последней, Для использования процедур этого раздела программист должен подготовить собственную процедуру с заголовком, соответствующим такому формату:

type


h0109.htm

MouseHandlerType =

Procedure (Mask,Buttons,X,Y,DX,DY: Integer);

Здесь Mask — условие вызова процедуры; Buttons — состояние клавиатуры в момент вызова; X,Y — координаты положения мыши; DX,DY — общее количество шагов мыши в горизонтальном (DX) и вертикальном (DY) направлениях.

Условие вызова процедуры пользователя определяется состоянием разрядов параметра Mask по такому соглашению:

• бит 1 — вызов при нажатии левой кнопки мыши;

• 2 — при нажатии правой кнопки;

• 3 — при нажатии средней кнопки;

• 4 — при отпускании левой кнопки;

• 5 — при отпускании правой кнопки;

• 6 — при отпускании средней кнопки.

Если параметр Mask имеет значение 0, драйвер не вызывает процедуру пользователя.

Процедура пользователя не может быть локальной (т.е. не может определяться в теле другой процедуры), ее параметры должны соответствовать типу MouseHandlerType.

Процедура SetMouseHandler. Извещает драйвер о необходимости передачи управления процедуре пользователя. Заголовок:

Procedure SetMouseHandler(Mask: Word; Proc: MouseHandlerType). Здесь Mask — условие вызова; Proc — процедура пользователя.

Процедура ChanqeMouseJiandler. Заменяет ранее объявленную процедуру пользователя на новую. Заголовок:

Procedure ChangeMouseHandler (Mask: Word; Proc:

MouseHandlerType; var OldMask: Word; var OldProc: Pointer).

Процедура возвращает в переменной OldMask условие вызова, а в OldProc — адрес ранее установленной процедуры пользователя.

Процедура ClearMouseHandler. Удаляет ранее установленный обработчик событий от мыши. Заголовок:

Procedure ClearMouseHandler.

Если к моменту обращения к этой процедуре была объявлена процедура пользователя (с помощью вызова SetMouseHandler), драйвер перестает ее вызывать.

4.2.10. Тестовая программа

Следующая довольно длинная программа иллюстрирует некоторые приемы работы с подпрограммами модуля F_Mouse. В программе создается экран, показанный на рис.4.1.


h0110.htm

НО Глава 4

Демонстрация возможностей модуля FJIouse

Рис.4.1. Вид экрана для тестовой программы

После запуска программы она ожидает одно из трех возможных событий: нажатие клавиши F1 — в этом случае предлагается возможная форма указателя мыши; F2 — переход из текстового режима в графический и обратно; Esc — завершение работы программы и возврат в ДОС. Замечу, что для сохранения идентичности экранов независимо от текущего режима работы (текстового или графического) в программе используются процедуры модулей F_Text1 и F_GrText. При этом изображения на экране оказываются настолько похожими, что для неискушенного взгляда единственным отличием режимов является лишь форма указателя мыши.

Вы можете выбирать эти продолжения не только с помощью клавиш, но и мышью. Для этого необходимо сместить указатель мыши так, чтобы он попал внутрь соответствующего прямоугольника, и нажать левую кнопку мыши.

При выборе формы указателя в текстовом режиме на экране разворачивается окно, содержащее все символы ПК в диапазоне от 1 до 255. Сместив указатель к нужному символу и нажав левую кнопку мыши, можно выбрать форму указателя. В графическом режиме программа предлагает меню из 4 возможных форм: стандартный указатель, пере—

' Модуль F_Text предназначен для пода.ержки многостраничной работы в текстовом режиме. Поскольку объем этой книги оказался чрезмерно большим, пришлось пожертвовать описанием этого модуля и особенностей работы в текстовом режиме. Текст модуля Вы найдете в прил.7.


h0111.htm

крестие, кружок и квадрат. Для выбора формы указателя в графическом режиме используется процедура, получающая управление от драйвера мыши при любом перемещении ее по столу. В этой процедуре определяется текущее положение указателя и высвечивается негативным изображением указатель той или иной формы.

^———————————————————————————+

Программа, демонстрирующая возможности \ ¦ модуля F_Mouse \ +——_——————————————————————+^

Uses CRT,DOS,Graph,F_Mouse,F_GrText,F_Text;

const

tl = ' Демонстрация возможностей модуля F_Mouse ' ;

t2 = ' Состояние мыши: ';

t3: array [1..4] of String [22] =

('Координаты: Х= Y= ','Левая кнопка :', 'Правая кнопка :','Средняя кнопка:');

NItem = 3;

t4: array [1..NItem] of String [24] =

(' Изменить указатель (Fl)',' Сменить режим (F2)', ' Завершить работу (Esc)') ;

type

ItemT = array [1..NItem] of MouseItemType;

const

Items: ItemT =(

(XI: 9; Yl: 4; X2:35; Y2: 6; Butt: LeftButton; Key:59 shi 8), (XI:44; Yl: 4; X2:68; Y2: 6; Butt: LeftButton; Key:60 shi 8), (X1:26; Y1:18; X2:51; Y2:20;utt: LeftButton; Key:27));

Text: Boolean аг True;

var

k,n,b,x,y,bb,xx,yy: Integer;

Font: Pointer;

FontSize: Word;

type

GotoXYType = procedure (X,Y: Byte);

ColorsType = procedure (Text,Back: Byte);

SetWindowType = procedure (XI,Y1,X2,Y2,Border: Byte;

Header: String;lip,Build,Play: Boolean);

ChangeCursorType = procedure;

var

Colors: ColorsType;

GotoXY: GotoXYType;

SetWindow: SetWindowType;

ChangeCursor: ChangeCursorType;

Procedure SetScreen;

/Создает экран в текстовом или графическом режиме} begin


h0112.htm

{Создаем основное окно} Colors(Black,LightGray) ;

SetWindow(1,1,80,25,DoubleBorder,tl,True,False,False);

{Создаем элементы выбора} Colors(Black,Green);

for k := 1 to NItem do with Items[k] do begin

SetWindow(XI,Yl,X2,Y2,SingleBorder,'',True,False,False) ;

Write(t4[k]) end;

{Создаем панель статуса} Colors(White,Red) ;

SetWindow(24,9,55,16,DoubleBorder,t2,True,False,False) ;

n := (3O-Length(t2)) div 2;

for k := 1 to 4 do begin

GotoXY(n-3,k+l) ;

Write(t3[k]) end end; {SetScreen} {____——————————————}

Procedure ChangeTextCursor; Far;

{Изменяет курсор в текстовом режиме} const

t = ' Выберите символ для указателя мыши ';

var

k: Byte;

n,x,y: Integer;

begin {Создаем окно выбора} HideMouse;• PutWindow(8,7,73,12,White,Blue,

DoubleBorder,1,t,True,False/False) ;

{Выводим в нем все символы, кроме Bel,BS,LF,CR} for k := 1 to 255 do

if k in [7,8,10,13] then

Write (' ') else

Write(chr(k)) ;

{Формируем пределы перемещения указателя} MouseWindow(MouseGraphCooX(9),MouseGraphCooY(8), MouseGraphCooX(72),MouseGraphCooY(11)) ;

{Цикл до в>тпускания левой кнопки} Repeat

GetMouseState(b,x,у) ;

until b and LeftButton=O;

ShowMouse;

{Цикл до нажатия левой кнопки}


h0113.htm

Repeat

GetMouseState(b,x,y);

until b and LeftButtonoO;

HideMouse;

{Определяем выбранный символ}

x := MouseTextCooX(х)-8;

у := MouseTextCooY(у)-7;

х := (у-1)*64+х;

if x>255 then

х := 1; . {Меняем форму курсора}

MouseTextCursor($FFOO,$7FOO+x);

{Восстанавливаем экран}

GetWindow(1) ;

MouseScreen;

ShowMouse

end; {ChangeTeatCursor} {————,—————————————}

{Глобальные определения для обработчика событий от мыши, используемого в режиме выбора графического указателя} const

DX = 40; {Шаг смещения изображений}

NCur =4; {Количество изображений} var

kk, {Ранее выбранное изображение}

хО, {Левая граница изображения}

y0,yl: Integer; {Вертикальные границы}

РР: Pointer; {Изображение указателя}

SizePP: Word; {Его размеры в памяти} Procedure MouseHandler(Mask,Buttons,X,Y,dDX,DY: Integers-Far;

{Отслеживает перемещения мыши и инвертирует изображение,

на которое указывает в данный момент указатель мыши} var

k: Integer; {Текущее изображение} begin

k := (х-ХО) div DX;

if k<l then k := 1;

if k>NCur then k := NCur;

if k=kk then

Exit; {Текущее изображение не изменилось) {Гасим старое и выделяем новое изображение}

PutImage(xO+(2*kk-l) *DX div 2, y0, PP^NormalPut) ;

GetImage(xO+(2*k-l)*DX div 2,y0,x0+(2*k+l)*DX div 2,yl,P?^);

PutImage(xO+(2*k-l)*DX div 2,y0,PP",NotPut) ;

kk := k


h0114.htm

end; {MouseHandler} {——————_——_————.———}

Procedure ChangeGraphCursor; Par;

{Изменяет курсор в графическом режиме} const.

t = ' Выберите указатель: ' ;

var

x,y,xl: Integer;

Size,b: Word;

p: Pointer;

Cur: array [1..NCur,0..1,0..15] of Word;

Proc: MouseHandlerType;

{————————}

Procedure PutCur(N: Byte);

{Сканирует изображение в левом верхнем углу экрана и формирует маски указателя} var

х,у: Byte;

b: Word;

begin

for у := 0 to 15 do begin b := 0;

for x := 0 to 15 do

if GetPixel (x,y) OGetBkColor then b := b or ($8000 shr x) ;

Cur[N,l,y] := b;

Cur[N,O,y] := not b end;

ClearViewPort end; {PutCur} {————————}

begin {ChangeGraphCursor}

{Готовим окно 16х16 в левом верхнем углу экрана} Size := ImageSize(О,0,15,15) ;

GetMem(P,Size) ;

GetImage^O/lS,]^,?^) ;

SetViewPort(0,0,15,15,ClipOn) ;

ClearViewPort;

{Готовим маски указателей} HideMouse;

if InitMouse then

ShowMouse; {Получаем стандартное изображение} SetMouseItem(NItem,Items) ;

MouseGotoXY(0,0); {Стандартный указатель} PutCur(1);

HideMouse;


h0115.htm

Circle (8,8,4); {Кружок}

PutCur(2) ;

Line(0,8,15,8); {Перекрестие}

Line(8,0,8,15) ;

PutCur(3) ;

Rectangle(0,0,15,15); {Квадратик}

PutPixel(7,7,15) ;

PutCur(4) ;

SetViewPort(O,O,GetMaxX,GetMaxY,ClipOn) ;

{Готовим окно для меню указателей}

PutImage (0, 0, P-'^NormalPut) ;

FreeMem(P,Size) ;

х0 := GraphCooX(9) ;

у0 := GraphCooY(7) ;

xl := GraphCooX(36) ;

yl := GraphCooY(lO) ;

Size := ImageSize(xO,yO,xl,yl);

GetMem(P,Size) ;

Getlmage(xO,yO,xl,yl,P") ;

Colors(White,Blue) ;

SetWindow(9,7,35,9,DoubleBorder,t,True,False,False);

{Выводим изображения указателей}

yl := yO+16;

for kk := 1 to NCur do for у := 0 to 15 do begin

xl := xO+kk*DX;

b := Cur[kk,1,y];

for x := 0 to 15 do

if b and ($8000 shr x)<>0 then

PutPixel(xl+x,yl+y,White) end;

{Уста на влив а ем пределы перемещения указателя}

yO := yO+16;

yl := у1+16;

MouseWindow(xO,yO,xl+DX,yl) ;

{Выделяем первое изображение}

SizePP := ImageSize(xO+DX div 2,yO,xO+3*DX div 2,yl);

GetMem(PP,SizePP) ;

Getlmage (xO+DX div 2,yO,xO+3*DX div 2,yl,PP-^);

PutImage (xO+DX div 2, yO, PP^NotPut) ;

kk := 1;

{Устанавливаем свой обработчик событий}

SetMouseHandler(l,MouseHandler) ;

{Цикл до нажатия левой кнопки}

repeat

GetMouseState(k,x,у)

until k and LeftButtonoO;


h0116.htm

{Удаляем обработчик событий}

ClearMouseHandler;

FreeMem(PP,SizePP) ;

{Формируем новый указатель}

kk := (х-х0) div DX;

if kk>NCur then kk := NCur;

if kk<l then kk := 1;

MouseGraphCursor(Cur[kk,0,0],0,0) ;

{Восстанавливаем экран}

Putlmage(x0,yO-16,P^/NormalPut) ;

FreeMem(P,Size);

MouseWindow(0,0,GetMaxX,GetMaxY) ;

F_GrText.Window(25,10,54,15) ;

Colors(White,Red) ;

ShowMouse

end; {ChangeGraphCursor} ^—.————————..——————;

Procedure SetTextScreen;

{Создает текстовый экран} begin

if not Text then

begin {Был графический режим} FreeMem(Font,FontSize); {Удаляем шрифт} GraphWriteOff; (Восстанавливаем ввод/вывод} CloseGraph; {Переходим к текстовому режиму} Text := True end;

{Указываем нужные для текстового режима процедуры) GotoXY := F_Text.GotoXY;

Colors := F_Text.Colors;

SetWindow := F_Text.SetWindow;

ChangeCursor := ChangeTextCursor;

{Ус та на влив а ем стандартный коэффициент пересчета} TextRatioY :=• 8;

{Создаем текстовый экран.}

SetScreen

end; {SetTextScreen} ^_—— ——.—.———.__—._——__;

Procedure SetGraphScreen;

{Создает графический экран} var

d,r: Integer;

h: Byte;

Name: String;

F: File;

begin


h0117.htm

if Text then {Инициируем графику} begin

d := Detect;

InitGraph(d,r,'') ;

if GraphResultOgrOk then

Exit;

{Выбираем шрифт в зависимости от разрешения экрана} case GetMaxY of

349: h := 14; {EGA 8х14}

479: h := 19; {VGA 8х19} else

h := 8 {Прочие 8х8} end;

{Загружаем шрифт из файла BxH.fnt} Str (h,Name) ;

Name := '8x'+Name+'.fnt';

Assign(F,Name) ;

{$!-} Reset(F,1),•

{$!+} if IOResult<>0 then Exit;

FontSize := FileSize(F);

GetMem(Font,FontSize) ;

BlockReadtFyFont",FontSize,r) ;

Close(F) ;

if rOFontSize then begin

FreeMem(Font,FontSize) ;

Exit end;

{Регистрируем шрифт и переназначаем ввод/вывод} SetFont(Font,8,h) ;

GraphWriteOn;

Text := False end;

{Указываем нужные для графического режима процедуры]-GotoXY := F_GrText.GotoXY;

Colors := F_GrText.Colors;

SetWindow := F_GrText.SetWindow;

ChangeCursor := ChangeGraphCursor;

{Задаем коэффициент пересчета вертикального положения указателя мыши в текстовый размер: он равен высоте шрифта} TextRatioY := h;

{Создаем графический экран}

SetScreen end; {SetGraphScreen}


h0118.htm

{—————————}

begin {Основная программа} CursorOff; {Удаляем курсор} SetTextScreen; {Формируем текстовый экран} {Инициируем мышь. Эту процедуру всегда следует осуществлять

после установки или смены режима работы дисплея} if not InitMouse then . Halt;

ShowMouse;

{Указываем элементы выбора) SetMouseItem(NItem,Items);

{Основной цикл работы продолжается до выбора элемента "Завершить работу" или нажатия Esc} {Запоминаем начальное состояние мыши} GetMouseState(b, x,у) ;

While (True) do {"Бесконечный" цикл} begin

{Проверяем выбор элементов} if KeyOrMousePressed then case ReadKeyOrMouse of {Есть выбор}

#27: Halt; {Esc}

#0: case ReadKeyOrMouse of

#59: ChangeCursor; {Fl-Изменить курсор}

#60: begin {F2-Сменить режим}

HideMouse; {Убираем мышь перед сменой режима} if Text then

SetGraphScreen {Был текстовый режим} else

SetTextScreen; {Был графический режим} if InitMouse then {Инициируем мышь

после смены режима!} ShowMouse;

SetMouseItem(NItem,Items) {Заново указываем элементы выбора, т.к. они сбрасываются при инициации мыши} end;

end {case} end; {case}

{Получаем текущее состояние мыши} GetMouseState(bb,xx,yy);

if (bbob) or (xxox) or (yyoy) then

begin {Состояние изменилось - сообщить} b := bb;

x : = xx ;

у := yy;

GotoXY(n+ll,2) ;

Write(MouseTextCooX(x):2);

GotoXY(n+16,2);


h0119.htm

Write(MouseTextCooY(у):2) ;

GotoXY(n+13,3) ;

if b and LeftButtonoO then

Write('нажата ') else

Write('отпущена');

GotoXY(n+13,4) ;

if b and RightButtonoO then

Write('нажата ') else

Write('отпущена');

GotoXY(n+13,5) ;

if NumButton=3 then

if b and CenterButtonOO then

Write('нажата ') else

Write('отпущена');

end {if (bboO) or. .. } end {while TRUE} end.


h0120.htm

Глава 5 ДОСТУП К ОТОБРАЖАЕМОЙ ПАМЯТИ

5.1. ЧТО ТАКОЕ ОТОБРАЖАЕМАЯ ПАМЯТЬ

Ранние IBM— совместимые ПК типа IBM PC/XT оснащались микропроцессорами 8088 или 8086, способными работать с оперативной памятью емкостью не более 1 Мбайт. Несмотря на значительные размеры этой памяти, в некоторых прикладных программах ее оказывается недостаточно. Такие программы вынуждены интенсивно использовать диск для размещения больших объемов данных, что сильно снижает их производительность. Поэтому почти одновременно с появлением IBM PC/XT начались поиски путей повышения производительности крупных прикладных программ (табличных процессоров, систем управления базами данных и т.п.) за счет использования оперативной памяти большего, чем 1 Мбайт разме — ра. Эти поиски привели к выработке соглашения между ведущими фирмами—разработчиками программно—аппаратных средств, которое известно как EMS LIM (от Expanded Memory Specification. — спецификация отображаемой1 памяти, удовлетворяющая стандарту фирм Lotus—Intel-Microsoft). В соответствии с этим стандартом ПК оснащаются специальными EMS— платами, содержащими собственно отображаемую память и микросхемы, обеспечивающие доступ к ней. В настоящее время EMS стал промышленным стандартом, которому следуют все поставщики программно — аппаратных средств.

В специальной технической литературе, используются термины «дополнительная память», «отображаемая память», «верхняя память» и т.д. Обилие терминологических определений, связанных с памятью ПК, требует пояснений.

Прежде всего замечу, что операционная система MS-DOS, а следовательно, и подавляющее большинство работающих под ее управлением программ могут использовать лишь первый мегабайт памяти, который часто называют базовой памятью. Эта память в рамках ДОС поделена на две неравные части: первые 640 Кбайт отводятся для программ пользователя и самой ДОС и называются стандартной памятью, а оставшиеся 384 Кбайт зарезервированы для памяти видеоадаптеров и ПЗУ и называются верхним блоком памяти [Uper Memory Block}. В то же время в компьютерах IBM AT имеется возможность адресовать память объемом до 16 Мбайт, если в них используется микропроцессор 80286, или до 4 Гбайт, если используется микропроцессор 80386 или 804862 .

* Термин expanded memory в буквальном переводе означает расширенная, дополненная память. Приблизительно такой же смысл имеет термин extended memory, которым обозначается память, лежащая за пределами первого мегабайта. Используемый в книге термин отображаемая память призван устранить часто возникающую путаницу этих понятий.

2 Объем непосредственно адресуемой оперативной памяти определяет разрядность адресной шины микропроцессора: 8088 и 8086 имеют 20-разрядную шину, поэтому адресуют


h0121.htm

Память ПК, остающаяся за вычетом первого мегабайта (т.е. за вычетом базовой памяти), называется дополнительной [Extended Memory). Эта память доступна только в специальном, так называемом защищенном, режиме работы микропроцессоров 80286/80386/80486. Поскольку защищенный режим не поддерживается в MS-DOS, его не использует и подавляющее большинство прикладных программ, работающих под управлением этой операционной системы. Таким образом, владелец современного компьютера IBM AT, оснащенного памятью, скажем, в 8 Мбайта, работая с MS — DOS — программами, часто либо вообще не использует дополнительные 7 Мбайт, либо размещает в них электронный диск или буферную кэш—память для дисков. В версии Турбо Паскаля 7.0 (точнее, в пакете Borland Pascal with Objects 7.0) введена поддержка защищенного режима микропроцессоров 80286/80386/80486, в котором используется дополнительная память (см. главы 8...10).

Помимо базовой, отображаемой и дополнительной памяти, в IBM AT существует еще так называемая верхняя память (не путайте с верхним блоком памяти!). Как известно, 20—разрядный адрес на IBM AT в реальном режиме и на компьютерах IBM PC/XT образуется путем сложения двух 16-разрядных слов — сегмента и смещения. Перед сложением сегмент смещается на 4 разряда влево (умножается на 16), что и обеспечивает 20-разрядный результат сложения — адрес конкретного байта. Формальное сложение сегмента и смещения может привести к переполнению 20-разрядной адресной сетки. Действительно, если, например, сегмент Seg = $FFFF, а смещение 0/s = $0010, то сложение $FFFF*16+$O010 дает значение $100000, для представления которого требуется уже 21 разряд.

Поскольку в IBM PC/XT применяется 20—разрядная шина, переполнение результата не может использоваться и «лишний» 21—и разряд просто теряется, т.е. на таких ПК адресация с сегментом Seg = $FFFF и смещением Ofs > $OOOF эквивалентна адресации с сегментом Seg = $0000 и смещением Ofs = 0/s—$0010. В адресной шине IBM AT имеется 21—и разряд, но его использование обычно запрещено. Однако в таких компьютерах предусмотрена возможность программного управления 21—м разрядом. Если этот разряд разблокировать, программе, работающей в реальном режиме процессора, станут доступны еще почти 64 Кбайта (без 16 байт). Эта часть памяти и называется верхней (High Memory Area}. MS-DOS версии 5.0 и более поздних, а также некоторые совместимые с ней операционные системы других фирм (например, DR—DOS фирмы Digital Research версии 4.0 и позже) могут размещать в верхней памяти свои резидентные части, тем самым освобождая драгоценную стандартную память для программ пользователя.

Итак, существуют 4 вида оперативной памяти:

• базовая — с адресам от $00000 до $FFFFF;

• верхняя — с адресами от $100000 до $1OFFEF;

• дополнительная ~ с адресами от $100000 до $FFFFFFFF;

220 = i 048 576 = 1 Мбайт; 80286 оснащен 24-разрядной шиной и адресует 224 = 16777216 = 16 Мбайт; 32-разряднс1Я шина 80386 и 80486 адресует 232 = 4 294 967 296 = 4 Гбайт.


h0122.htm

• отображаемая — организуется специальными аппаратными средствами на компьютерах с микропроцессорами 8088, 8086, 80286 и может программно эмулироваться на процессорах 80386 и 80486.

Каким образом микропроцессоры типа 8088/8086, имеющие 20-разрядную адресную шину, получают доступ к отображаемой памяти, т.е. к памяти, лежащей за пределом 1 Мбайт? Для этого аппаратным способом реализуется '"отображение небольшого участка отображаемой памяти, называемого окном, в адресное пространство микропроцессора. Отображаемое окно занимает адреса, которые не используются в ПК. Обычно эти адреса лежат за границей 640 Кбайт, т.е. принадлежат верхнему блоку памяти (см. рис.5.1).

Рис.5.1. Память ПК

Возможность отображения EMS— памяти в участок верхнего блока связана с тем, что ни видеоадаптер, ни ПЗУ не используют все адреса этого блока. Действительно, для адресации к видеопамяти адаптера VGA требуется не более 640х480/8 = 38400 байт адресного пространства1 , а адаптеров EGA и CGA — и того меньше; даже видеопамять SVGA с разрешением 1024х768 использует менее 100 Кбайт; с учетом того что для ПЗУ обычно выделяется 64 или 128 Кбайт, остается 150 Кбайт и более свободного адресного пространства. В эти адреса и отображается окно EMS— памяти.

' Речь идет об адресном пространстве, используемом для обращения к видеопамяти. Фактический объем видеопамяти VGA составляет от 64 до 256 Кбайт. Доступ к остальной части этой памяти организуется схемами контроллера.


h0123.htm

Программа может управлять аппаратными средствами EMS— платы, в частности, она может связывать окно с различными участками отображаемой памяти. Таким образом, для использования отображаемой памяти программа должна указать, какую именно часть EMS— памяти связать с окном, и затем работать с данными по адресам отображаемого окна, т.е. по адресам выше 640 Кбайт (но, разумеется, ниже 1 Мбайт): при каждом обращении к окну аппаратура EMS— платы «подставляет» вместо несуществующей базовой памяти с этими адресами нужный участок отображаемой памяти.

Отображаемое окно использует EMS— память порциями по 16 Кбайт. Эти порции называются страницами. Одновременно в окне может отображаться от одной до четырех страниц. Таким образом, максимальная емкость окна не может превышать 64 Кбайт, в то время как максимальная емкость EMS— памяти составляет 32 Мбайт (2048 страниц).

Еще раз подчеркну, что наличие на Вашем ПК памяти за границей 1 Мбайт (обычно это легко выявляется в ходе автотестирования сразу после включения компьютера) еще не означает, что эта память — отображаемая. Главное отличие отображаемой памяти от дополнительной заключается в том, что первая может отображаться в адресное пространство до 1 Мбайта, а вторая — не может. Отображение реализуется аппаратным способом, поэтому для доступа к EMS— памяти компьютер, использующий процессор 80286 или более ранний (8088, 8086, V20 и т.п.), должен оснащаться специальной платой. Начиная с версии 4.0, операционная система MS-DOS поставляется с драйвером отображаемой памяти XMA2EMS.SYS и эмулятором EMM386.SYS. Последний на ПК с микропроцессорами 80386/80486 обеспечивает эмуляцию отображаемой памяти, т.е. программно реализует функции EMS— платы и преобразует дополнительную память в отображаемую.

5.2. ФУНКЦИИ ДРАЙВЕРА ОТОБРАЖАЕМОЙ ПАМЯТИ

Работа EMS— платы управляется специальным драйвером, который называется EMM (Expanded Memory Manager — администратор отображаемой памяти). Существует несколько версий EMM. В этом разделе описываются функции драйвера отображаемой памяти так, как они реализованы в EMM версии 4.0. Однако перед тем как рассматривать функции EMM, полезно обсудить некоторые подробности его работы.

Как уже говорилось, отображаемая память выделяется программе страницами по 16 Кбайт каждая. Эти страницы отображаются в окне, имеющем размеры 64 Кбайта, т.е. окно способно отобразить до четырех страниц одновременно. Условимся в дальнейшем называть страницы окна физическими, а страницы EMS— памяти логическими.

Поскольку логических страниц может быть гораздо больше физических, необходимо каким—то образом управлять процессом отображения в окне, т.е. устанавливать связи между окном и отображаемой памятью. Эта задача в EMM решается следующим образом. Для использования EMS— памяти программа должна создать так называемый дескриптор EMM. С дескриптором связывается одна или несколько (до 2048) логических


h0124.htm

страниц. В программе может создаваться произвольное количество дескрипторов, однако память, выделенная одному из них, не может использоваться никакими другими дескрипторами, поскольку каждый дескриптор владеет своей памятью монопольно. При обращении к большинству функций EMM программа должна указывать дескриптор и тем самым определять логические страницы, о которых идет речь.

Для установления связи между логическими страницами дескриптора и физическими страницами окна используется специальная процедура, которая называется картированием окна. При картировании Вы должны указать номер физической страницы и номер той логической страницы, содержимое которой должно отображаться в этой физической странице окна. Нумерация как логических, так и физических страниц начинается с нуля, т.е. допустимыми являются номера 0...3 для физических и О... N— 1 для логических страниц (N — полное количество страниц, которыми владеет дескриптор).

В табл.5.1 приводится краткая характеристика функций EMM версии 4.0.

Таблица 5.1 ___________Функции драйвера отображаемой памяти_________

Функция | Действия
$40 | Дать статус EMM
$41 | Получить сегментную часть адреса отображаемого окна
$42 | Получить информацию о EMS — памяти
$43 | Создать дескриптор EMM и распределить память
$44 | Картировать окно
$45 | Уничтожить дескриптор EMM и освободить память
$46 | Дать номер версии БММ
$47 | Сохранить картирующий контекст
$48 | Восстановить картирующий контекст (предварительно контекст должен быть сохранен с помощью функции $47)
$4В | Дать количество активных дескрипторов
$4С | Дать количество связанных с дескриптором страниц
$4D | Дать информацию о распределении памяти
$4Е | Дать/установить карту всех страниц
$4F | Дать/установить карту части страниц
$50 | Картировать/освободить несколько страниц одновременно
$51 | Изменить количество связанных с дескриптором страниц
$52 | Получить/установить флаг сохранения страниц
$53 | Установить/получить имя дескриптора
$54 | Дать список имен дескрипторов или искать дескриптор по имени
$55 | Картировать память и выполнить инструкцию JUMP
$56 | Картировать память и выполнить инструкцию CALL
$57 | Переместить/обменять блок памяти
$58 | Получить полную карту EMS—окна

Для обращения к EMM используется программное прерывание с вектором $67. Чтобы вызвать нужную функцию EMM, следует поместить в регистр АН номер функции, соответствующим образом сформировать остальные регистры и вызвать прерывание $67. При выходе из преры—


h0125.htm

вания регистр АН содержит статус возврата — код, характеризующий успешность запроса. Ненулевое значение статуса указывает на ошибку обращения (см. табл.5.2).

Таблица 5.2

 | Коды ошибок EMM
Код | Значение
$00 | Нет ошибок, функция выполнена (во всех остальных случаях — не выполнена)
$80 | Внутренняя ошибка EMM
$81 | Сбой EMS—платы
$82 | EMM занят обработкой предыдущего запроса
$83 | Неверный дескриптор окна
$84 | Запрошена неопределенная в данной версии EMM функция
$85 | Нет доступных дескрипторов окон
$86 | Ошибка при сохранении или восстановлении окна
$87 | Запрос распределения превышает общую EMS—память
$88 | Запрос распределения превышает число доступных страниц
$89 | Попытка создать дескриптор с нулевым количеством страниц
$8А | Дескриптор не располагает таким числом страниц
$8В | Попытка картировать больше 4 страниц
$8С | Переполнение области сохранения картирующего контекста
$8D | Попытка повторного сохранения картирующего контекста
$8E | Попытка восстановления несохраненного контекста
$8F | Не определен параметр подфункции
$90 | Неизвестный тип атрибутов
$91 | Нет аппаратной подд.ержки сохраняемых страниц
$92 | Источник и приемник информации одновременно находятся в EMS— памяти (предупреждение, не ошибка)
$93 | Размер приемника информации слишком мал
$94 | Стандартная память частично перекрывает отображаемую память
$95 | Слишком большое смещение в перемещаемом блоке
$96 | Размер перемещаемого блока больше 1 Мбайт
$97 | Источник и приемник связаны с одним дескриптором и частично перекрываются
$98 | Недопустимый тип памяти источника или приемника
$9А | Нет аппаратной подд.ержки альтернативной установки страниц
$9В | Исчерпаны все допустимые установки альтернативных регистров
$9С | Не поддерживается установка альтернативных регистров
$9D | Неправильная установка альтернативных регистров
$9Д | Назначенные каналы прямого доступа к памяти (КПДП) не поддерживаются
$9F | Указанный КПДП не поддерживается
$AO ' | Дескриптор не поименован
$А1 | Указанное имя дескриптора уже существует
SA2 | Источник выходит за границу 1 Мбайт
$АЗ | Содержимое указанное области данных разрушено
$А4 | Нет доступа к указанной функции

Дать статус EMM

Вход: АН = $40. Выход: АН — статус EMM.

Эта функция позволяет программе проконтролировать состояние только что завершившейся операции с EMS— памятью. Содержимое регистра АН кодирует состояние EMM так, как это указано в табл.5.2.


h0126.htm

Получить сегмент отображаемого окна

Вход: АН = $41. Выход: J3X — сегмент окна.

После обращения к этой функции программа сможет определить адрес участка верхнего блока памяти, в котором создано отображаемое окно EMS. Начало каждой физической страницы соответствует адресу

BX+1024*N:0000,

где ВХ — сегмент окна, N — номер физической страницы (0...3). Поскольку положение окна не меняется, программа может обратиться к этой функции лишь один раз и затем использовать полученный адрес при любых операциях с отображаемой памятью.

Получить информацию о EMS-памяти

Вход: АН = $42. Выход: DX — общее число страниц (по 16 Кбайт каждая);

ВХ — количество свободных страниц.

С помощью функции $ 4 2 программа может получить, информацию об общем количестве логических страниц (регистр DX) и количестве свободных в данный момент страниц (регистр ВХ).

Создать дескриптор и распределить память

Вход: АН = $43;

ВХ — требуемое количество страниц (от 1 до 2048). Выход: DX — дескриптор EMM.

Новый дескриптор создается функцией $43. При обращении к ней в регистре ВХ указывается количество логических страниц, связываемых с дескриптором. Это количество не должно превышать значения, возвращаемого в регистре ВХ функцией $42. EMM не гарантирует, что выделенные дескриптору страницы будут располагаться в смежных физических блоках (т.е., например, соответствовать непрерывному адресному пространству дополнительной памяти, если отображаемая память эмулируется драйвером EMM386.SYS), однако он строго следит за тем, чтобы никакой другой дескриптор не использовал их. Программа должна сохранить полученный Ё регистре DX дескриптор для использования выделенной ему памяти.

Картироватъ окно

Вход: АН = $44;

AL = номер логической страницы (от 0 до 3);

ВХ = физический номер страницы (от 0 до N— 1, где

N — количество страниц, связанных с данным дескриптором);

DX = дескриптор EMM.

Функция $44 осуществляет привязку одной логической страницы к конкретной физической странице, т.е. картирование окна. После выхода из этой функции указанная физическая страница будет отображать новую


h0127.htm

логическую страницу, в то время как содержимое остальных физических страниц останется неизменным. Замечу, что любая физическая страница может быть связана с любой логической страницей, т.е. одна и та же ло — гическая страница при необходимости может отображаться в двух, трех или даже во всех четырех страницах окна одновременно. Если какая-либо физическая страница останется не связанной ни с одной логической, EMM блокирует доступ к странице: при чтении из нее любой байт будет содержать код $FF (255) и запись по любому байту в пределах несвязанной страницы не меняет этого значения.

Уничтожить дескриптор EMM и освободить память

Вход: АН = $45;

DX — дескриптор.

Функция $45 уничтожает дескриптор и освобождает связанные с ним логические страницы. Не забывайте вызывать эту функцию в конце работы с EMS— памятью, так как в отличие от кучи отображаемая память не освобождается автоматически в момент завершения работы программы! Более того, я настоятельно рекомендую перехватить процедуру выхода (как это сделать см. в гл.2) и в новой процедуре при необходимости сделать вызов этой функции, так как программа может завершиться аварийно и выделенная дескриптору (дескрипторам) память будет потеряна для остальных программ впредь до перезагрузки ДОС. Этот прием избавит Вас от дополнительных хлопот при отладке программы.

Дать номер версии EMM

Вход: АН = $46. Выход: AL — номер версии в двоично—десятичном формате.

С помощью функции $ 4 6 программа может получить номер версии того EMM, с которым она работает в данный момент. Если Вы собираетесь писать коммерческую программу, такая проверка будет весьма кстатИг так как описываемые ниже функции $4F. . .$58 доступны Только для версии 4.0 и недоступны в ранних. После возврата из этой функции регистр AL содержит номер версии в двоично—десятичном формате: старший полубайт — первую цифру, младший — вторую. Например, для версии 4.0 в регистре содержится $40=64, а для более ранней версии 3.2 — $32'=50.

Сохранить/восстановить картирующий контекст

Вход: АН = $47 — сохранить контекст;

= $48 — восстановить контекст;

DX = дескриптор.

Функции $47 и $48 используются в ситуациях, когда нужно временно сохранить текущую карту страниц. Такие ситуации могут возникнуть, например, перед вызовом процедур, использующих Тит же самый дескриптор. Вызовы функций $47 и $48 должны быть парными. Это означает, что если Вы для одного и того же дескриптора дважды подряд попытаетесь вызвать функцию $47 без промежуточного вызова функции $48, это


h0128.htm

приведет к возникновению ошибки $8D, а повторный вызов $48 без вызова $47 — ошибки $8Е.

Дать количество активных дескрипторов

Вход: АН == $4 в. Выход: ВХ — количество дескрипторов.

Функция $4 В возвращает в регистре ВХ количество активных в данный момент дескрипторов, а функция $4 С — количество связанных с дескриптором логических страниц (см. замечание к функции $4 С).

Дать количество связанных с дескриптором страниц

Вход: АН = $4 С;

DX = дескриптор. Выход: ВХ = количество страниц.

С помощью этой функции Вы можете получить количество связанных с дескриптором логических страниц.

При выполнении следующей программы на экран выводится общее количество дескрипторов и свободная EMS— память к моменту начала работы программы, затем создается новый дескриптор и ему передается вся доступная память. В заключение вновь выводится общее количество дескрипторов и количество страниц, которыми владеет вновь созданный дескриптор, после чего дескриптор уничтожается.

Uses DOS;

var

Reg: Registers;

Procedure Intr67;

{Выполняет прерывание $67 с регистрами, заданными значениями переменной Reg} begin

Intr($67,Reg) ;

if Reg.ahoO then begin

WriteLn('Ошибка ',Reg.ah);

Halt end end;

va-

Handle: Word;

begin

with Reg do

begin

^Определяем общее количество дескрипторов} ah := $4В;

Intr67;

WriteLn('Используется',bx:3,' дескрипторов');

{Определяем объем всей и доступной EMS-памяти}


h0129.htm

ah := $42;

Intr67;

WriteLn(dx:15,' страниц EMS-памяти');

WriteLn(bx:15, ' страниц - свободно');

{Создаем новый дескриптор}

ah := $43;

Intr67;

Handle := dx;

{Определяем количество страниц, которыми он владеет}

ah := $4С;

Intr67;

WriteLn('Создан новый дескриптор, владеющий ', bx,' страницами');

{Проверяем общее количество дескрипторов}

ah := $4В;

Intr67;

WriteLn('(общее количество дескрипторов':35,bx:2,')');

{Уничтожаем новый дескриптор}

ah := $45;

dx := Handle;

Intr67;

WriteLn('Новый дескриптор уничтожен:') ;

{Указываем количество оставшихся дескрипторов}

ah := $4В;

Intr67;

Write (' осталось ',Ьх,' дескрипторов, ');

ah := $42;

Intr67;

WriteLn(bx,' свободных страниц') end end.

Дать информацию о распределении памяти

Вход: АН = $4D;

ES-.DI — адрес буфера. Выход: BX — количество активных дескрипторов.

С помощью функции $40 программа может получить информацию обо всех активных дескрипторах. Она возвращает общее количество дескрипторов в регистре BX, а информацию о каждом из них — в массиве, адрес которого передается функции в регистрах ?5 (сегмент) и DI (смещение). Для каждого дескриптора в этом массиве должно быть предусмотрено два 16—разрядных слова, в которые функция помещает сам дескриптор (в первое слово) и количество связанных с ним страниц (во второе).

Дать/установить карту всех страниц Вход: АН = $4Е;


h0130.htm

AL = номер подфункции:

О — получить в буфере по адресу ES:DI карту страниц;

1 — установить карту страниц из буфера по адресу DS:SI;

2 — комбинация подфункций 0 и 1;

3 — дать размер буфера для подфункций О...2. BbixoA:AL — размер буфера (для подфункции 3).

Буфер ES:DI заполняется картой страниц (подфункции 0 и 2). функция $4Е используется для быстрой смены содержимого окна. Для этого следует предварительно получить текущую карту страниц с помощью подфункции 0, а затем изменить картирующий контекст. После этого быстрый возврат к прежнему контексту осуществляется с помощью подфункций 1 или 2. Подфункция 3 возвращает размер буфера ES:DI, необходимый для подфункций 0 и 2.

Дать/установить карту части страниц

Вход: АН = $4Р;

AL — номер подфункции: ' О — получить карту;

1 — установить карту;

2 — получить размер буфера для подфункции 0;

ВХ — количество страниц (для подфункции 2);

DS: SI — адрес описателя запроса (для подфункции 0) или карты страниц (для подфункции 1);

ES:DI — адрес буфера (для подфункции 0).

Функция $4F аналогична функции $4Е, но используется для сохранения/восстановления картирования не всех, а только указанных физических страниц. Подфункция 0 обеспечивает сохранение картирования. При обращении к ней регистры DS:SI должны содержать адрес описателя запроса, а регистры ES:DI — адрес буфера, куда будет помещена нужная информация. В первое 2—байтное слово описателя запроса программа помещает общее количество физических страниц, для которых запоминается картирующий контекст, а в остальные слова — сегментные части адресов тех страниц, о которых идет речь.

Как и функция $4Е, функция $4Р предназначена для обслуживания многозадачных систем.

Картировать/освободить несколько страниц одновременно

Вход: АН = $50;

AL — номер подфункции:

О — использовать номера физических страниц;

1 — использовать сегменты физических страниц;

DX — дескриптор EMM;

СХ — количество 4—байтных элементов в б_^ере запроса (по одному элементу на каждую страницу);

DS.-5J — адрес буфера запроса.

Функция $50 обеспечивает картирование сразу нескольких (до четыре^ физических страниц. При обращении к ней регистр AL должен содержат


h0131.htm

Доступ к отображаемой памяти 1У1

указание на то, как выбираются физические страницы: если AL'=0 — по номерам, если AL=1 — по сегментам. В регистре СХ должно содержаться количество картируемых страниц, в регистре DX — дескриптор, а в DS-.SI — адрес описателя запроса. Описатель запроса содержит по два слова на каждую картируемую страницу. В первом слове указывается номер логической страницы, а во втором •'- номер (для подфункции AL^O) или сегмент (AL=1) физической страницы. Если в качестве номера логической страницы указан код $FPFF, соответствующая физическая страница перестает быть связанной с какой-либо логической: чтение из нее возвращает значение $FF (255) в любом байте и запись в нее не меняет этого значения.

Изменить количество связанных с дескриптором страниц

Вход: АН = $51;

DX = дескриптор EMM;

ВХ = новое количество страниц.

С помощью функции $51 программа может изменить количество связанных с дескриптором страниц. При обращении к ней регистр DX содержит ранее созданный дескриптор, а ВХ — новое количество логических страниц, связываемых с этим дескриптором. Если ВХ меньше того количества, которым располагает дескриптор к моменту вызова функции, освобождаются страницы со старшими номерами.

Получить/установить флаг сохранения страниц

Вход: АН = $52;

AL = номер подфункции:

О — получить флаг;

1 — установить флаг;

2 — дать признак аппаратной поддержки функций 0 и 1. Выход: AL = флаг сохранения — для подфункции 0 или признак

аппаратной поддержки для подфункции 2. Некоторые EMS— платы поддерживают так называемые сохраняемые страницы. Содержимое таких страниц не меняется при «горячей» перезагрузке ДОС, т.е. при перезагрузке без выключения питания (реализуется кнопкой RESET или клавишами Ctrl-Alt-Del). С помощью функции $52 программа может объявить сохраняемыми страницы, связанные с некоторым дескриптором. Для этого необходимо обратиться к подфункции AL=l, указав в регистре DX дескриптор, а в ВХ флаг сохранения. Если флаг равен единице, страницы становятся сохраняемыми, если нулю — не сохраняемыми. С помощью подфункции AL~=0 можно проверить флаг сохранения страниц (0 — не сохраняются, 1 — сохраняются), а подфункция 2 возвращает в AL признак аппаратной поддержки сохраняемых страниц (0 — нет пода.ержки, 1 — есть поддержка).

Установить/получить имя дескриптора Вход. АН = $53;


h0132.htm

AL — номер подфункции:

О — получить имя;

1 — установить имя;

DX — дескриптор EMM;

ES:DI — адрес буфера для подфункции 0;

DS:SI — адрес имени для подфункции 1. Для более удобной реализации связей внутри многозадачных систем можно организовать доступ к дескрипторам по их именам. С этой целью в EMM предусмотрены функции $53 и $54. Первая позволяет установить новое имя дескриптора или получить ранее установленное имя. Вторая обеспечивает поиск дескриптора по его имени. При обращении к подфункции 0 функции $53 (получить имя) в регистре DX указывается дескриптор, а в регистрах ES:DI — адрес буфера длиной 8 байт. В этот буфер помещается связанное с дескриптором имя, соответствующее структуре

array [1..8] of Char

Если имя ранее не было определено, буфер содержит пробелы. При обращении к подфункции 1 (задать имя) в регистрах DS:S/ указывается адрес массива из восьми символов. Эти символы без какого-либо изменения помещаются во внутренний буфер EMM и в дальнейшем могут использоваться для поиска дескриптора. В качестве символов имени можно задавать любые символы ПК от #0 д® #255.

Дать список имен дескрипторов или искать дескриптор по имени

Вход: АН == $54;

AL — номер подфункции:

О — дать список имен;

1 — искать дескриптор;

2 — дать количество активных дескрипторов;

ES:DI — адрес буфера для подфункции 0;

DS.\ST — адрес имени для подфункции 1. Выход: AL — количество дескрипторов (для подфункции 2) или дескриптор (для подфункции 1).

Буфер по адресу ES:DI заполняется списком имен

(для подфункции 0).

функция $54 предназначена в основном для поиска дескриптора по его имени (подфункция 1). Однако с ее помощью можно также получить список имен (подфункция 0) и количество активных дескрипторов (подфункция 2). При обращении к подфункции 0 в ES:DI указывается адрес буфера. Каждому активному дескриптору в этом буфере должно быть выделено по 10 байт: первые два байта при выходе из функции содержат сам дескриптор (его идентификационный номер), а остальные 8 байт — связанное с ним имя.

Картировать память и выполнить инструкцию JUMP

Вход: АН = $55;

AL — номер подфункции:


h0133.htm

О — использовать' номера физических страниц;

1 — использовать сегменты страниц;

DX — дескриптор EMM;

DS:SI — адрес буфера запроса. Функции $55 и $56 используются при размещении в отображаемой памяти исполняемых программ. При обращении к функции $55 (картиро— вать и выполнить JUMP) в регистрах DS'.DI содержится адрес описателя запроса. Описатель должен иметь длину 9 байт и соответствовать следующей структуре: первые 4 байта содержат сегмент и смещение точки, куда передается управление по инструкции JUMP FAR, следующий за ними байт указывает количество N картируемых страниц, а остальные 4 байта определяют полный адрес (т.е. сегмент и смещение) массива, описывающего новую карту страниц. Этот массив должен состоять из N пар слов и содержать номер логической страницы (первое слово каждой пары) и номер (для подфункции AL^O) или сегмент (AL=l) физической страницы (второе слово), функция $55 сначала осуществляет нужное картирование, а затем реализует инструкцию JUMP FAR.

{Сортировать память и выполнить инструкцию CALL

Вход: АН = $56;

AL — номер подфункции:

О — использовать номера физических страниц;

1 — использовать сегменты страниц;

2 — получить требуемый размер стека;

DX — дескриптор EMM;

DS:SI — адрес буфера запроса. Выход: ВХ — размер стека (для подфункции 2).

Работает приблизительно так же, как функция $55, но после картирования реализует инструкцию вызова подпрограммы CALL. При обращении к подфункциям 0 и 1 в регистрах DS:SI указывается адрес 22— байтного описателя вызова. Первые 9 байт этого описателя аналогичны описателю для функции $55. За ними следует еще один байт длины и FAR— адрес той карты страниц, которую необходимо установить перед выходом из подпрограммы. Последние 8 байт описателя зарезервированы для использования в EMM. С помощью подфункции 2 программа может получить размер области стека, используемой при вызове подфункций 0 и 1 функции $56.

Переместить/обменять блок памяти

Вход: АН = $57

AL — номер одфункции:

О — переместить блок;

1 — обменять блок;

DS:SI = адрес буфера запроса.

С помощью функции $57 программа может перемещать большие блоки данных как внутри EMS— памяти, так и между отображаемой и стандартной памятью. Максимальная длина перемещаемого блока составляет 1


h0134.htm

Мбайт. Допускается полное или частичное перекрытие сегментов. Подфункция 0 осуществляет перемещение блока на новое место, а 1 — обмен блоков (источник помещается на место приемника и наоборот). При обращении к ним в регистрах D5;5J указывается адрес следующего описателя запроса:

MoveBlockType == record

Size : Longint; {Длина блока в байтах) SourceType-: Byte; {Тип источника: 0 - основная память,

1 - отображаемая память} SourceHand: Word; {Дескриптор EMM, если источник

находится в EMS-памяти, или О,

если в основной] SourceOffs: Word; {Смещение начала источника

внутри страницы или сегмента} SourceSegm: Word; {Сегмент или страница источника} DestinType: Byte; {Тип приемника:0 - основная память,

1 - отображаемая} DestinHand: Word; {Дескриптор EMM, если приемник

находится в EMS-памяти, или 0} DestinOffs: Word; {Смещение приемника} DestinSegm: Word; {Сегмент или страница приемника} end;

Получить полную карту EMS-окна

Вход: АН = $58;

AL — номер подфункции:

О — получить карту;

1 — получить длину карты. Выход: СХ — длина карты (для подфункции 1);

ES:DI — буфер (для подфункции 0). С помощью функции $58 программа может получить полную карту БАК—окна. При обращении к подфункции 0 регистры ES:DI содержат адрес буфера, в который будет помещена карта, а при вызове подфункции 1 драйвер помещает в регистр СХ количество 4—байтных элементов этой карты. Первое слово каждого элемента содержит сегмент физической страницы, а второе слово — номер той логической страницы, которая в данный момент отображается в этой физической. Эта карта содержит N элементов, где N — количество активных физических страниц (некоторые физические страницы могут не быть связанны с EMS— памятью).

5.3. МОДУЛЬ F_EMS

Достаточно подробное описание функций EMM, приведенное в предыдущем параграфе, позволит Вам при необходимости создать собственный интерфейс низкого уровня для доступа к этим функциям. В описываемом ниже модуле F_EMS я попытался реализовать более удобный,


h0135.htm

как мне кажется, способ использования отображаемой памяти. Полный текст модуля приведен в прил.П6.

С этой целью в интерфейсной части модуля определена иерархия объектов, показанная на рис.5.2.

Рис.5.2. Иерархия объектов модуля F_EMS

Базовым объектом иерархии является объект TEMSArea. EMS— память в рамках этого объекта рассматривается как массив вида

type

EMSMemory = array [0..Size-1] of Byte,

где Size — длина резервируемой объектом памяти.

Объект TEMSVector порожден от TEMSArea и предназначен для начального структурирования данных. Этот объект рассматривает отображаемую память как набор фрагментов, каждый из которых имеет одинаковую длину в байтах. В стандартном Паскале ему в какой—то степени соответствует одномерный массив из элементов произвольного типа.

От TEMSVector порожден объект TEMSMatrix, имитирующий двумерные массивы стандартного Паскаля. Он перекрывает методы родителя, чтобы обрабатывать обращение к элементам с помощью двух индексов. Как и в стандартном Паскале, элементы в объекте TEMSMatrix располагаются по столбцам: за элементом с индексами 1,1 располагается элемент 1,2 и т.д.

Объект TEMSArray также порожден от TEMSVector и имитирует массив с произвольным количеством измерений. Фактические индексы элемента при обращении к процедурам Setltem и Getltem задаются в виде списка, что не очень удобно, вот почему для моделирования одно— и двумерных массивов используются отдельные объекты.

Объект TEMSType порожден от TEMSArea и имитирует файл с последовательным доступом (ленточный накопитель). Его элементы могут иметь различную длину, поэтому доступ к очередному элементу возможен только после чтения (записи) предыдущего элемента.


h0136.htm

136___________________________________________________Глава 5

Объект TEMSText также имитирует последовательный файл, но его элементами являются строки.

Наконец, потомок TEMSScreen базового объекта TEMSArea предназначен для хранения в EMS— памяти копии графического экрана.

Использование объектов модуля F_EMS снимает многие ограничения Турбо Паскаля на объем обрабатываемых данных. Более того, поскольку индексы массивов и максимальные размеры сохраняемых данных определяются как длинные целые числа, использование процедур модуля может упростить программу. Например, максимальная длина любого массива, размещаемого в динамической памяти, не может быть больше 64 Кбайт, поэтому более крупные массивы приходится размещать в куче порциями;

при использовании объектов модуля F_EMS этого делать не нужно. Однако следует помнить, что доступ к EMS— памяти осуществляется с помощью более или менее сложных объектных методов и поэтому происходит значительно медленнее, чем обращение к базовой памяти.

5.3.1. Объекты модуля

TEMSArea

Этот объект является основой иерархии объектов модуля F_EMS. Методы объекта интерпретируют доступную ему EMS— память как одну очень длинную цепочку байт. Единственное, что умеет делать объект с этой памятьЮг это записывать в нее данные или читать данные из нее. Для этого в объект включены базовые методы WriteEMS (писать в EMS— память) и ReadEMS (читать из памяти). Эти методы можно рассматривать как модификацию стандартной процедуры Move на случай обмена данными с EMS— памятью: при обращении к ним нужно указать адрес источника, адрес приемника и количество пересылаемых байт. Отличие от Move состоит в том, что это количество задается параметром типа Longint, что позволяет обмениваться массивами данных произвольного размера (стандартная процедура Move обеспечивает передачу не более 65535 байт).

Для большинства практических целей более удобно пользоваться наследниками этого объекта.

Поля

Size Size: Longint; Только чтение Определяет размер (в байтах) связанной с объектом отображаемой памяти.

МахРаде MaxPage: Word; Только чтение

Определяет количество EMS— страниц по 16 Кбайт каждая, в которых размещаются Size используемых объектом байт.

Handle Handle: Word; Только чтение

Дескриптор EMM, владеющий МахРаде страницами EMS— памяти.

Методы

Init Constuctor Init (ASize: Longint);


h0137.htm

Перекрывается: Часто

Инициирует объект: определяет количество МахРаде страниц EMS— памяти, достаточное для размещения ASize байт, создает дескриптор Handle и связывает с ним МахРаде страниц.

Done Destructor Done; Virtual;

Перекрывается: Редко

Освобождает EMS— память, связанную с дескриптором Handle. He забывайте использовать вызов этого метода, перед тем как завершить работу с объектом или перед окончанием работы программы, поскольку выделенная дескриптору память остается в его монопольном распоряжении, даже если сам дескриптор уже не существует.

EMSError Procedure EMSError (NError: Byte); Virtual;

Этот метод вызывается всеми другими методами объекта TEMSArea и его потомков в случае, если обнаружена какая-либо ошибка. Параметр NError определяет номер ошибки. Если NErrorOO, метод устанавливает глобальный признак ошибки EMSErrorFlag, который может проанализировать вызывающая программа, затем выводит на экран текстовое сообщение о характере возникшей ошибки. Сообщение выводится с помощью стандартной процедуры WriteLn. Вы должны перекрыть метод EMSError в графическом режиме работы дисплея, если не используете модуль F_GrText или не осуществляете самостоятельной интерпретации вызова процедуры WriteLn. Этот метод следует перекрывать также в потомках для вывода сообщений о нестандартных ошибках. Исходный метод выдает нужное сообщение в случае, если номер ошибки лежит в диапазоне $80..$AD. Несколько необычная левая граница диапазона связана с тем, что диапазон $80..$А4 соответствует стандартным ошибкам драйвера EMM.SYS (см. п.5.2). В табл.5.3 указаны номера ошибок и соответствующие им сообщения.

Таблица 5.3 Сообщения об ошибках, выдаваемые процедурой TEMSArea.EMSError

Код | Значение
$80 | Внутренняя ошибка EMM
$81 | Сбой EMS—платы
$82 | EMM занят обработкой предыдущего запроса
$83 | Неверный дескриптор окна
$84 | Запрошена неопределенная в данной версии EMM функция
$85 | Нет доступных дескрипторов окон
$86 | Ошибка при сохранении или восстановлении окна
$87 | Запрос распределения превышает общую EMS — память
$88 | Запрос распределения превышает число доступных страниц
$89 | Попытка создать дескриптор с нулевым количеством страниц
$8А | Дескриптор не располагает таким числом страниц
$8В | Попытка картировать больше 4 страниц
$8С | Переполнение области сохранения картирующего контекста
$8D | Попытка повторного сохранения картирующего контекста
$8E | Попытка восстановления несохраненного контекста
$8F | Не определен параметр подфункции
$90 | Неизвестный тип атрибутов
$91 | Нет аппаратной поддержки сохраняемых страниц


h0138.htm

138 Глава 5

$92 | Источник и приемник информации одновременно находятся в EMS—памяти
$93 | Размер приемника информации слишком мал
$94 | Стандартная память частично перекрывает отображаемую память
$95 | Слишком большое смещение в перемещаемом блоке
$96 | Размер перемещаемого блока больше 1 Мбайт
$97 | Источник и приемник связаны с одним дескриптором и частично перекрываются
$98 | Недопустимый тип памяти источника или приемника
$99 | Неопознанная ошибка
$9А | Нет аппаратной поддержки альтернативной установки страниц
$9В | Исчерпаны все допустимые установки альтернативных регистров
$9С | Не поддерживается установка альтернативных регистров
$9D | Неправильная установка альтернативных регистров
$9E | Назначенные каналы прямого доступа к памяти (КПДП) не поддерживаются
$9F | Указанный КПДП не поддерживается
$AO | Дескриптор не поименован
$А1 | Указанное имя дескриптора уже существует
$А2 | Источник выходит за границу 1 Мбайт
$АЗ | Содержимое указанной области данных разрушено
$А4 | Нет доступа к указанной функции
$А5 | Нет EMS—памяти или не установлен драйвер EMM.SYS
$А6 | Неверный формат файла
$А7 | Ошибка при чтении объекта из файла
$А8 | Ошибка при записи объекта в файл
$А9 | Попытка чтения за границей доступной BMS— памяти
$АА | Попытка записи за границей доступной HMS — памяти
$АВ | Неверные границы индексов
$АС | Размер элемента вектора не соответствует длине переменной
$AD | Изменен режим работы дисплея (объект TEMSScreen)

Если при обращении к методу указана ошибка, выходящая за диапазон $80..$AD, выдается сообщение

Ошибка номер XXX

ReadEMS Procedure ReadEMS (Source: Longint; var Dest; Sz:

Longint); Virtual;

Перекрывается: Никогда

Этот метод обеспечивает низкоуровневый интерфейс с EMS— памятью для чтения данных из нее в переменную Dest. Параметр Source определяет номер байта отображаемой памяти, с которого начинается обмен данными (самый первый байт соответствует Source=0). Sz определяет общее количество передаваемых байт. Dest — переменная иди участок кучи, куда будет помещена прочитанная из EMS— памяти информация. Фактически метод осуществляет обмен данными порциями, не превышающими 16 Кбайт, однако разбивка всего массива на эти порции и картирование нужных страниц EMS— памяти делается внутри метода и вызывающая программа не должна об этом заботиться.

Load Constructor Load (var F: File) ;

С помощью этого метода программа может прочитать из файла F объект TEMSArea, ранее записанный в файл методом Store, файл F должен быть нетипизированным файлом. Перед обращением к методу его следует открыть, указав длину блока в 1 байт. Позиционирование указателя внутри файла должно осуществляться в вызывающей программе. Вначале метод читает из файла заголовок объекта — строку,


h0139.htm

Доступ к отображаемой памяти_____ 139

соответствующую глобальной константе RegHeadTEMSArea. Затем читаются поля МахРад и Size. После этого создается дескриптор Handle и с ним связываются МахРаде страниц. Наконец из файла считываются и помещаются в EMS— память Size байт данных.

Store Procedure Store (var F: File); Virtual;

Перекрывается: Часто

Записывает в файл Р текущее состояние объекта TEMSArea. Файл F должен быть нетипизированным файлом. Перед обращением к методу программа должна открыть его, указав длину блока в 1 байт. Метод вначале записывает в файл заголовок объекта — глобальную константу RegHeadTEMSArea, затем поля МахРаде, Size и, наконец, все Size байт из EMS— памяти.

Следующий пример иллюстрирует технику использования методов 5tore и Load.

Uses F_EMS;

var

Area: TEMSArea;

F: File;

begin

Area.Init (100000); {Резервируем в EMS 100000 байт} {.......) {Наполняем EMS-память данными}

Assign(F,'Test.dat'); {Связываем файловую переменную с

именем вновь создаваемого файла} Rewrite(F,1); {Создаем файл; длина блока данных

равна 1 байту!} Store(F); {Сохраняем данные в файле};

Area.Done; {Освобождаем EMS-память} Seek(F,0); {Позиционируем указатель на начало файла} Area.Load(F); {Читаем все поля и данные

объекта TEMSArea из файла F} /....... } {Используем данные}

Area.Done {Освобождаем EMS-память} end.

WriteEMS Procedure WriteEMS (var Source; Destin, Sz:

Longint); Virtual;

Перекрывается: Никогда

Записывает Sz байт данных из переменной Source в EMS— память, пропустив Destin байт от ее начала. Вместе с методом ReadEMS обеспечивает низкоуровневый доступ к отображаемой памяти. Фактический обмен данными осуществляется порциями по 16 Кбайт. Разбивка всего массива Sz байт на порции и необходимое картирование EMS— памяти осуществляется внутри метода.

TEMSVector_______________________________________

Объект TEMSVector имитирует обычный одномерный массив Паскаля. Его элементами могут быть любые данные одинаковой длины — методы Setltem и Getltem могут соответственно записать в EMS— память или про—


h0140.htm

читать из нее любую переменную либо область памяти подходящей длины. В этом полиморфизме методов заключается главное отличие объекта от обычных одномерных массивов Паскаля. Для удобства доступа к структурированным данным в объект включены интерфейсные методы XXXXItem, преобразующие элемент данных к одному из стандартных типов. При обращении к конструктору Init указывается длина элемента, а также минимальное и максимальное значения индексных выражений: для доступа к любому элементу данных необходимо указать его индекс. В отличие от массивов Турбо Паскаля индексные выражения и границы индексов задаются значениями типа Longint, что позволяет хранить в EMS— памяти массивы произвольной длины. Объекты метода осуществляют проверку значений индексных выражений на принадлежность заданному при обращении к Init диапазону. Такая проверка приводит к дополнительным потерям времени и уменьшает и без того невысокую скорость доступа к элементам данных. Если Вы уверены в корректности индексных выражений и хотите несколько увеличить скорость доступа, Вы должны включить в начало модуля директиву компилятора {$DEF NOTCHECK} или указать слово NOTCHECK в поле Options/ Compiler/Conditional defines диалоговой среды. Такая настройка заставит компилятор исключить из программы фрагменты, связанные с проверкой индексных выражений.

Поля

ItemS Items: Longint; Только чтение

Хранит длину элемента данных. Интерфейсные методы XXXXItem проверяют значение этого поля и блокируют доступ к элементу, если значение ItemS не соответствует длине типа данных.

Minind Minind: Longint; Только чтение

В это поле метод Init помещает левую границу индексных выражений.

Maxind Maxind: Longint; Только чтение

В это поле метод Init помещает правую границу индексных выражений.

Методы

Init Constructor Init (ASize, Min, Max: Longint);

Создает объект: вначале по границам индексных выражений Min, Мах и длине элемента ASize определяет требуемую длину EMS— памяти, затем вызывает родительский метод TEMSArea.Init и помещает значения ASize, Min, Мах в поля ItemS, Minind и Maxind.

Load Constructor Load (var F: File);

Перекрывается: Иногда

Создает объект, считывая все его поля и данные из файла F. Вначале обращается к родительскому методу TEMSArea.Load, затем читает из файла заголовок RegHeadTEMSVector (см. п.5.3.2) и поля ItemS. Minind, Maxind. Перед обращением к методу файловую переменную F необ — ходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для чтения блоками длиной в 1 байт.


h0141.htm

Доступ к отображаемой памяти 141

Store Procedure Store (var F: File); Virtual;

Перекрывается: Иногда

Сохраняет текущее состояние объекта в файле F: вначале вызывает унаследованный метод TEMSArea.Store, затем записывает в файл заголовок RegHeadTEMSVector и поля ItemS, Minind, Maxind. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для чтения блоками длиной в 1 байт.

Getltem Procedure Getltem (var Dest; Index: Longint) ;

Перекрывается: Редко

Помещает в переменную Dest элемент с индексом Index: вначале определяет положение ItemS'(Index—Minind) элемента относительно начала EMS— памяти, затем вызывает TEMSArea.ReadEMS для чтения из памяти ItemS байт.

Setltem Procedure Setltem (var Source; Index: Longint);

Перекрывается: Редко

Читает из переменной Source ItemS байт и помещает их в элемент с индексом Index: вначале определяет положение ItemS'(Index—Minind) элемента относительно начала EMS— памяти, затем вызывает TEMSArea. WriteEMS для записи в память ItemS байт.

Byteltem Function Byteltem (Index: Longint): Byte;

Возвращает значение элемента с индексом Index в типе Byte: вначале проверяет поле ItemS, которое должно иметь значение SizeOf(Byte), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Byte.

Doubleltem Function DoubleItem (Index: Longint) : Double;

Возвращает значение элемента с индексом Index в типе Double:

вначале проверяет поле ItemS, которое должно иметь значение SizeOf(Double), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Double.

Extendedltem Function ExtendedItem (Index: Longint) : Extended;

Возвращает значение элемента с индексом Index в типе Extended:

вначале проверяет поле ItemS, которое должно иметь значение SizeOf(Extended), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Extended.

Integerltem Function IntegerItem (Index: Longint) : Integer;

Возвращает значение элемента с индексом Index в типе Integer:

вначале проверяет поле ItemS, которое должно иметь значение SizeOf(Integer), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Integer.

Longlntltem Function LongIntItem (Index: Longint): Longint;

Возвращает значение элемента с индексом Index в типе Longint:

вначале проверяет поле ItemS, которое должно иметь значение SizeOf(LongInt), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Longint.

Realltem Function Realltem (Index: Longint) : Real;


h0142.htm

Возвращает значение элемента с индексом Index в типе Real: вначале проверяет поле ItemS, которое должно иметь значение SizeOf(Real), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Real.

Singleltem Function Singleltem (Index: Longint) : Single;

Возвращает значение элемента с индексом Index в типе Single: вначале проверяет поле ItemS, которое должно иметь значение SizeOf(Single), затем вызывает Getltem и преобразует полученное значение элемента Index к типу Single.

TEMSMatrix________________________________________

"Объект содержит средства для работы с двумерными массивами в EMS— памяти. Он перекрывает методы своего родителя TEMSVector для обеспечения доступа к элементам массива по двум индексам. Для этого в объект включен метод GetVedndex, с помощью которого два индекса преобразуются к одному индексу массива TEMSVector с нулевой левой границей. Пересчет осуществляется по стандартному правилу Паскаля:

элементы двумерного массива располагаются в памяти таким образом, что при переходе от одного элемента к соседнему наиболее быстро изменяется второй индекс.

Поля

Minlndl Minlndl: Longint Только чтение

Содержит левую границу первого измерения.

Maxindl Maxindl: Longint Только чтение

Содержит правую границу первого измерения.

Minlnd2 MinInd2: Longint Только чтение

Содержит левую границу второго измерения.

Maxlnd2 Maxlnd2 : Longint Только чтение

Содержит правую границу второго измерения.

Методы

Init Constructor Init (ASize, Mini, Maxi, Min2, Max2:

Longint);

Создает объект TEMSMatrix: по границам измерений Mini...Max2 определяет общее количество Sz элементов, вызывает родительский метод TEMSVector.Init с границами 0, Sz—1 и помещает границы Mini...Max2 в поля Minlndl...Maxlnd2.

Load Constructor Load (var F: File);

Перекрывается: Иногда

Считывает все поля и данные объекта TEMSMatrix из файла F: вначале вызывает родительский метод TEMSVector.Laad, затем читает из <^<ssxa. заголовок RegHeadTEMSMatrix (см. п.8.3.2) и поля Mi'rtJndI, MoxJndl, Minlnd2, Maxlnd2. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для чтения блоками длиной в 1 байт.


h0143.htm

Доступ к отображаемой памяти 143

Store Procedure Store (var F: File); Virtual;

Перекрывается: Иногда

Сохраняет текущее состояние объекта в файле F: вначале вызывает унаследованный метод TEMSVector.Sfore, затем записывает в файл заголовок RegHeadTEMSMatrix и поля Minlndl, Maxindl, Minlnd2, Maxlnd2. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для записи блоками длиной в 1 байт.

GetVecIndex Function GetVecIndex (Indl, Ind2: Longint) :

Longint;

Осуществляет преобразование двух индексов Indl, Ind2 к единственному индексу родительского объекта TEMSVector с нулевой левой границей.

Все остальные методы объекта — Getltem, Setltem, Byteltem, Doubleltem, Extendedltem, Integerltem, Lognlntltem, Realltem и Singleltem — представляют собой двумерные варианты одноименных методов объекта TEMSVector.

TEMSAiray________________________________________

Объект TEMSArray содержит средства для создания в EMS— памяти массива произвольной размерности и работы с ним. Все индексные выражения пеоедаются методам объекта в виде списка, что не очень удобно, поэтому помимо объекта TEMSArray в модуле содержатся также объекты TEMSVector и TEMSMatrix. Многомерный массив TEMSArray порожден от TEMSVector и осуществляет соответствующий пересчет индексов в единственный индекс объекта—родителя с нулевой левой границей. Для этого служит метод GetVecIndex, использующий стандартное правило Паскаля: элементы массива располагаются в памяти так, что при переходе от одного элемента к соседнему наиболее быстро меняется самый правый индекс.

Поля

NIndex NIndex: Longint; Только чтение Содержит количество измерений массива.

Index Index: PIndex;

Указатель на размещенный в динамической памяти массив из NIndex троек чисел типа Longint. Каждая (А—я) тройка содержит левую (первое число), правую (второе число) границы индексов по данному (А—му) измерению и множитель (третье число), упрощающий пересчет многомерных индексных измерений в единственный индекс базового объекта TEMSVector. Множитель показывает на сколько нужно умножить А—ый индекс многомерного массива, чтобы получить положение элемента внутри одномерного массива с нулевой левой границей.

Методы


h0144.htm

144___________________ __ Глава 5

Init Constructor Init (ASize, NInd: LongInt; var Ind) ;

Создает объект TEMSArray. Параметры ASize и NInd задают соответственно длину элемента и количество измерений массива. Переменная Ind внутри метода считается переменной типа TIndexBond (см. п.5.3.2) и должна содержать N/nd пар чисел типа LongInt, определяющих границы индексов по каждому измерению (первое число пары — левая, второе — правая границы). Метод помещает в поле NIndex значение NInd, затем по списку Ind определяет общее количество Sz элементов массива, после чего вызывает унаследованный метод TEMSVector.Init с границами 0 и Sz-1. Если обращение к методу было успешным, в куче резервируется NInd' 12 байт и указатель на этот участок памяти помещается в поле Index (указатель на массив TIndex, см. п.5.3.2). Для всех NInd троек элементов типа LongInt массива Index' в первый элемент помещается левая граница, во второй — правая граница, а в третий — масштабный множитель, показывающий на сколько нужно умножить индекс по данному измерению, чтобы получить положение элемента в базовом объекте TEMSVector.

Load Constructor Load (var F: File);

Перекрывается: Редко

Считывает все поля и данные объекта TEMSArray из файла F: вначале вызывает родительский метод TEMSVector.Load, затем читает из файла заголовок RegHeadTEMSArray и поле NIndex. Резервирует в куче участок памяти длиной NIndex'Q байт, указатель на него помещает в поле Index и считывает в него из файла NIndex элементов массива типа TIndex. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для чтения блоками длиной в 1 байт.

Store Procedure Store (var F: Pile); Virtual;

Перекрывается: Редко

Сохраняет в файле F текущее состояние объекта: вызывает родительский метод TEMSVectore. Store, затем записывает в файл заголовок RegHeadTEMSArray, поле NIndex и все NIndex троек массива Index'. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для записи блоками длиной в 1 байт.

Done Destructor Done; Virtual;

Перекрывается: Редко

Уничтожает объект: освобождает участок кучи, связанный с указателем Index, затем вызывает родительский метод TEMSArea.Done для освобождения EMS— памяти.

GetVecIndex Function GetVecIndex (var Ind) : LongInt;

Перекрывается: Никогда

По массиву индексов, заданному в переменной Ind, возвращает единственный индекс одномерного базового объекта TEMSVector. Переменная Ind внутри метода считается массивом TIndexList и должна содержать NIndex' элементов типа LongInt, определяющих значения индексов (первый элемент — индекс первого измерения, второй — второго и т.д.). Этот метод можно использовать для доступа к типизированным интерфейсным функциям XXXXItem объекта—родителя TEMSVector.


h0145.htm

Доступ к отображаемой памяти 145

Getltem Procedure Getltem (var Dest, Ind) ;

Перекрывается: Никогда

Помещает в переменную Dest значение элемента массива, заданного списком индексов Ind типа TIndexList.

Setltem Procedure S'etltem (var Source, Ind);

Перекрывается: Никогда

Помещает значение переменной Source в элемент массива, заданный списком индексов /nd типа TIndexList.

TEMSType__________________________________________

Объект TEMSType содержит средства, позволяющие зарезервировать участок EMS— памяти нужной длины и работать с этой памятью как с файлом последовательного доступа. С этой целью в объекте содержится поле Pos, в котором указывается текущее положение указателя записи/чтения (смещение указателя от начала памяти в байтах). Методы Setltem и Getltem позволяют записать в EMS— память или прочитать из нее массив байтов нужной длины. В объекте нет средств позиционирования указателя и контроля за длиной записываемых/считываемых элементов. Ответственность за правильное использование записанной в EMS— память информации возлагается на программиста.

Поля

Pos Pos: Longint Чтение/Запись

Содержит смещение в байтах указателя чтения/записи от начала EMS— памяти. Методы Setltem и Getltem используют это поле для определения текущего участка EMS— памяти и после чтения или записи информации увеличивают его значение на длину прочитанной (записанной) информации. Программа пользователя может произвольным образом распоряжаться этим полем, чтобы обеспечить доступ к нужному участку памяти. Обычно она должна записать в это поле ноль, чтобы заставить читать/записывать данные с самого начала памяти.

Методы

Init Constructor Init (ASize: Longint);

Создает объект: вызывает родительский метод TEM.SArea.lnit, чтобы зарезервировать в EMS— памяти ASize байт, затем помещает в поле Pos значение 0.

Load Constructor Load (F: File) ;

Перекрывается: Часто

Считывает объект из файла F: вызывает родительский метод TEMSArea.Load, затем читает из файла заголовок RegHeadTEMSType и поле Pos. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизированным файлом, а сам файл должен быть открыт для чтения блоками длиной в 1 байт.

Store Procedure Store (var F: File); Virtual;

Перекрывается: Часто


h0146.htm

146 _____________ _______________________Глава 5

Сохраняет в файле F текущее состояние объекта: вызывает унаследованный метод TEMSArea. Store, затем записывает в файл заголовок RegHeadTEMSType и поле Роз. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизи— рованным файлом, а сам файл должен быть открыт для записи блоками длиной в 1 байт.

Getltem Procedure Getltem (var Dest; Sz: Longint);

Перекрывается: Часто

Читает из участка EMS— памяти со смещением Pos байт от ее начала Sz байт в переменную Dest: вызывает родительский метод TEMSArea.ReadEMS с параметрами Pos, Dest и Sz, затем увеличивает значение поля Pos на величину Sz.

Setltem Procedure Setltem (var Source; Sz: Longint);

Перекрывается: Часто

Помещает в участок EMS— памяти со смещением Pos байт от ее начала Sz байт из переменной Source: вызывает родительский метод TEMSArea.WriteEMS с параметрами Source, Pos и Sz, затем увеличивает значение поля Pos на величину Sz.

TEMSText______

Объект позволяет разместить в EMS—памяти набор текстовых строк. В какой—то степени этому объекту соответствует текстовый файл стандартного типа Text. Объект порожден от TEMSType и наследует его поле Pos, содержащее текущее положение указателя чтения/записи от начала памяти. Метод Setltem размещает в памяти очередную строку S и увеличивает значение Pos на Length(S)+l. Метод Getltem читает строку из памяти и точно также смещает указатель Pos. Строка в EMS— памяти хранится в стандартном формате Паскаля: первый байт строки содержит ее Длину, затем следует цепочка символов. Эта форма не совпадает с форматом ASCII— строк, в соответствии с которым строка содержит цепочку символов, заканчибающуюся признаком EOL (последовательностью символов #13#10). Таким образом, объект нельзя считать полным аналогом текстового файла.

Методы

Getltem Function Getltem: String;

Возвращает размещенную в EMS— памяти текстовую строку, на которую указывает Pos, и увеличивает значение Pos на длину строки плюс один байт.

Setltem Procedure Setltem (S: String);

Помещает в участок EMS— памяти, на который указывает Pos, строку 5 и увеличивает значение Pos на величину Length(S)+l.

TEMSScreen______________________________________

Объект TEMSScreen предназначен для копирования текущего состояния экрана (текстового или графического) в EMS— память и восстановления экрана по его копии. Его метод Init определяет текущий режим работы


h0147.htm

Доступ к отображаемой памяти ___ 147

экрана с помощью прерывания BIOS $10 и в зависимости от этого резервирует EMS— память нужной длины. Код режима помещается в поле Mode и контролируется при вызове других методов объекта. Это означает, что если Ваша программа переключает режим работы дисплея, например переходит из текстового в графический, для сохранения копий экрана Вы должны использовать разные копии объекта TEMSScreen. Напротив, в рамках одного и того же режима единственная копия TEMSScreen может сколько угодно раз использоваться для сохранения/восстановления экрана. Поскольку унаследованные методы TEMSArea.Rea.dEMS и TEMSArea. Write— Ems не перекрываются, Вы можете использовать их для того, чтобы обойти это ограничение (например, чтобы объект, рассчитанный на работу с графическим экраном EGA/VGA, использовать для сохранения/восстановления текстового экрана). В табл.5.4 указывается объем резервируемой EMS^- памяти для наиболее распространенных дисплейных адаптеров.

Таблица 5.4 Объем резервируемой EMS-памяти. для различных дисплейных адаптеров___

Тип адаптера | Режим | Резервируемая память в страницах по 16 Кбайт
MDA | Все режимы | 1
CGA | Все режимы | 1
EGA | Текстовые | i
" | Графический 640х350 16 цветов | 7
VGA | Текстовые | 1
" | Графический 640х480 16 цветов | 10
SVGA | Графический 1024х?68 16 цветов | 24
 | Графический 1024х768 256 цветов | 48

Поля

Mode Mode: Byte; Только чтение

Код режима работы экрана на момент создания объекта. Все методы объекта (кроме Imt и Store) проверяют соответствие текущего режима работы режиму, указываемому этим полем.

Методы

Init Constructor Init;

Создает объект: с помощью прерывания $10 (подфункция $F) определяет текущий режим работы экрана, затем с помощью вызова родительского метода TEMSArea.Imt резервирует EMS— память нужного размера, после чего помещает в поле Mode код режима дисплея.

Load Constructor Load (P: Pile);

Считывает копию объекта из файла F: вызывает TEMSArea, затем читает из файла заголовок RegHeadTEMSScreen и поле Mode. Перед обращением к методу файловую переменную F необходимо связать с уже существующим нетипизироваиным файлом, а сам файл должен быть открыт для чтения блоками длиной в 1 байт.

Store Procedure Store (var F: File); Virtual;


h0148.htm

Сохраняет в файле F текущее состояние объекта: вызывает унаследованный метод TEMSArea.Store, затем записывает в файл заголовок RegHeadTEMSScreen и поле Mode. Перед обращением к методу файловую переменную F необходимо связать с уже существующим не— типизированным файлом, а сам файл должен быть открыт для записи блоками длиной в 1 байт.

GetScreen Procedure GetScreen;

Перекрывается: Редко

Сохраняет в EMS— памяти текущее состояние экрана. Все текстовые режимы, а также графические режимы адаптера CGA используют менее 16 Кбайт видеопамяти, поэтому их копирование осуществляется в единственную страницу EMS— памяти и происходит очень быстро. Графические режимы EGA/VGA/SVGA требуют более одной страницы для размещения копии экрана, поэтому копирование идет по частям и осуществляется намного медленнее. Части экрана, копируемые в одну страницу EMS, представляют собой узкие горизонтальные полосы. Для EGA/VGA эти полосы содержат по 50 строк развертки, поэтому полная копия состоит из 7 (EGA) или 10 (VGA) полос. Копии полос создаются с помощью процедуры Cetlmage стандартного модуля Graph.

PutScreen Procedure PutScreen;

Перекрывается: Редко

Восстанавливает вид экрана, который был к моменту предыдущего обращения к методу GetScreen, т.е. переносит копию из EMS— памяти на экран.

5.3.2. Глобальные ссылки

В этом разделе описываются все определения интерфейсной части модуля F_EMS.

Процедура DisposeEMSHandle Объявление: Procedure DisposeEMSHandle(var Handle: Word);

Функция: Уничтожает дескриптор Handle и освобождает связанную с ним EMS— память.

Переменная EMSErrorFlag

Объявление: const EMSErrorFlag: Boolean = False;

Функция: Хранит признак успешности предыдущего обращения к объектам и подпрограммам модуля: если после обращения к функциям EMM регистр АН содержит ненулевой код возврата, а также в случае обнаружения других ошибочных ситуаций, в эту переменную помещается значение True, в противном случае — False. Программа пользователя может проверить этот признак для анализа только что завершившегося обращения к методам и подпрограммам модуля.

Функция EMSSeg Объявление: Function EMSSeg: Word;

функция: Возвращает сегментную часть адреса окна, в которое отображаются логические страницы EMS— памяти.

Переменная EMSStatus Объявление: const EMSStatus: Byte;


h0149.htm

Функция: Хранит статус завершения (код возврата) предыдущего обращения к функциям EMM. Смысл различных значений этой переменной указан в табл.15.

Функция CctEMMVersion Объявление: Function FetEMMVersion: String;

Функция: Возвращает номер версии EMM в формате Х.Х. Например, для EMM версии 4.0 возвращается строка «4.0».

Процедура GetEMSInfo Объявление: Procedure GetEMSInfo(var AllPage, Pages: Word);

Функция: Возвращает в переменной AllPage общее число EMS— страниц, а в Pages количество свободных страниц (т.е. не связанных ни с одним дескриптором).

Функция IsEMS. Объявление: Function IsEMS: Boolean;

Функция: Определяет наличие в компьютере EMS— памяти и возвращает True, если память обнаружена. В электронном справочнике «Не1р\» фирмы Flambeaux Software, Inc. для проверки факта подключения драйвера EMS— памяти рекомендуется прочитать имя драйвера — строку «ЕММХХХХО», содержащуюся в его заголовке (со смещением 10 от начала заголовка); вектор прерывания $67 всегда содержит адрес заголовка, поэтому следующая подпрограмма может определить, загружен ли EMM:

Function IsEMM: Boolean;

type

THead = record

Beg: array [1..10] of Byte;

Head: array [1..8] of Char

end;

var

PHead:"Thead;

P: Pointer absolute PHead;

begin

GetIntVec($67,P) ;

IsEMM := PHead".Head»'ЕММХХХХО' end;

Однако па практике эта проверка не всегда дает правильный результат, так как вектор $67 может быть подменен другими резидентными программами, активно использующими EMS— память. После такой подмены этот вектор будет указывать на новый обработчик прерывания, в котором осуществляется контроль за использованием EMS— памяти и который вовсе не обязан содержать заголовок драйвера со смещением 10 байт от точки входа. В функции IsEMS используется более аккуратный прием, также рекомендуемый в справочнике «Help!»: в рамках MS-DOS драйвер EMM объявляется как внешний файл с именем «ЕММХХХХО»; функция создает дескриптор файла с этим именем с помощью вызова функции $3D MS-DOS и открывает его для чтения, после чего с помощью вызова IOCTL (функция $44 MS-DOS) проверяется статус файла. Если файл существует и его статус не равен нулю (что означает — устройство готово, нет конца файла), считается, что драйвер EMM подключен и


h0150.htm

150______________________________________________________Глава 5

EMS— память существует. В этом случае функция определяет версию EMM и помещает ее во внутреннюю переменную EMSVer. Поскольку вызов функции IsEMM осуществляется перед любым обращением к EMM, ненулевое содержимое этой переменной служит признаком того, что проверка уже произведена и EMM установлен. Если EMSVerOO, функция IsEMS не делает описанную выше проверку, а сразу возвращает True, экономя несколько миллисекунд на каждом обращении.

Процедура MapEMSPage. Объявление: Procedure MapEMSPage(Handle,Physic,Logic: Word);

Функция: Картирует окно, связывая его физическую страницу Physic с логической страницей Logic дескриптора Handle. Поскольку картирование окна выполняется практически перед каждым обращением к EMS— памяти, эта процедура реализована с помощью встроенного ассемблера. Кроме того, в ней запоминаются параметры обращения и, если очередное обращение не изменяет существующей карты страниц, блокируется вызов EMM. Эти меры экономят до 25% времени при интенсивной работе с EMS— массивами.

Процедура NewEMSHandle. Объявление: Procedure NewEMSHandle(var Handle: Word; Pages: Word);

Функция: Открывает новый дескриптор Handle и связывает с ним Pages страниц EMS— памяти.

Гипьг PEMSXXXX. Объявление: type

PEMSArray^TMSArray;

PEMSMatrix^TEMSMatrix;

PEMSScreen^TEMSScreen;

PEMSText="TEMSText ;

PEMSType^TEMSType;

PEMSVector^TEMSVector;

Функция: Определяют типы—указатели для размещения объектов модуля в динамической памяти.

Гип PIndex Объявление: type PIndex^TIndex;

Функция: Используется для размещения списка индексов многомерного массива TEMSArray в динамической памяти.

Константы RegHeadTEMSXXXX Объявление: const

RegHeadTEMSArea : String [14]='F_EMS TEMSArea';

RegHeadTEMSArray : String [14]='F_EMS TEMSArra';

RegHeadTEMSMatrix: String [14]='F_EMS TEMSMatr';

RegHeadTEMSScreen: String [14]='F_EMS TEMSScre';

RegHeadTEMSType : String [14]='F_EMS TEMSType';

RegHeadTEMSVector: String [14]='F_EMS TEMSVect';

Функция: Служат для идентификации объектов модуля при работе с файлами.

Тип TIndex Объявление: type TIndex = array [l..Max!nt div 6,1..3] of Longint;

Функция: Описывает массив индексов, используемый внутри объекта

TEMSArray.

Примечание. В программе не следует объявлять переменные типа TIndex, т.к. длина этого массива слишком велика. Тип используется как базовый для определения типа—указателя PIndex.


h0151.htm

Доступ к отображаемой памяти 151

Тип TIndexBond

Объявление: type TIndexBond = array [l-.MaxInt div 4, 1..2] of Longint;

Функция: Используется /у\я передачи конструктору TEMSArray.Init списка

граничных пар многомерного массива. См. примечание к TIndex.

Тип TIndexList Объявление: type TIndexList = array [l.-MaxInt div 2] of Longint;

функция; Используется для указания списка индексов многомерного массива

при обращении к методам объекта TEMSAnay. См. примечание к TIndex.

5.3.3. Тестовая программа

В следующей программе демонстрируются основные приемы работы с объектами и подпрограммами модуля F_EMS.

Работа программы заключается в выполнении нескольких тестов. Вначале с помощью функции IsEMS определяется доступность EMS— памяти: если функция возвращает False, выводится сообщение

Нет ЕМЗ-памяти. или не установлен EMM

и программа завершает работу. Если память доступна, сообщается общий объем памяти в страницах и количество свободных EMS— страниц.

Второй тест заключается в сопоставлении скорости доступа к стандартной и EMS— памяти. Для этого в куче создается несколько массивов длинных целых чисел по 16 Кбайт каждый, которые заполняются последовательно возрастающими значениями, после чего подсчитывается сумма всех элементов всех массивов. На экран выводится контрольная сумма и время, затраченное на работу. Затем создается объект TEMSVector такой же длины, как суммарная длина всех массивов в куче, его элементы заполняются монотонно возрастающими значениями, после чего подсчитывается контрольная сумма массива. Эта сумма и время счета также выводятся на экран. Разбивка на массивы по 16 Кбайт сделана, с одной стороны, чтобы приблизительно уравнять условия теста, а с другой, — это неизбежное следствие известного ограничения Турбо Паскаля: за одно обращение к менеджеру кучи нельзя зарезервировать больше 65521 байта. Этот тест показывает, что доступ к элементам EMS— массива идет в 5...10 раз медленнее, чем к массивам в стандартной памяти.

Следующий тест сохраняет созданный объект TEMSVector на диске, затем уничтожает объект и создает его вновь с помощью конструктора Load, после чего еще раз подсчитывает и выводит контрольную сумму массива.

В ходе выполнения четвертого теста создается объект TEMSText и в него считывается исходный текст тестовой программы. Затем средствами модуля F_Text на экране создается окно, в которое выводится эталонный текст программы, считанный непосредственно из PAS—файла, и текст, полученный из объекта. Если объект функционирует нормально, обе колонки окна должны содержать идентичные строки,


h0152.htm

IS2 Глава 5

В следующем тесте проверяется работа объекта TEMSScreen сначала для текстового, а затем графического режима работы экрана. При инициации графического режима предполагается, что нужный BGI— драйвер располагается в текущем каталоге. Если это не так, следует скорректировать вызов процедуры InitGraph, указав путь к каталогу с этим драйвером.

{

+--_--_----_------_------------------+

I Демонстрация основных возможностей ¦ ¦ модуля F_EMS I +------------------------------------+

;

Uses CRT,Graph,F_EMS,F_Text;

type

TV = array [O.-MaxInt div 2-1] of Longint;

var

All,Pages: Word;

k,j,x: Longint;

Vec: TEMSVector;

Тех: TEMSText;

Scr: TEMSScreen;

t: Longint;

d,r,e: Integer;

PV: array [0..40] of ^V;

Sz: Longint;

Sum: Comp;

f: file;

ft: Text;

s,ss: String;

const

LPage=16*1024;

label

L1,L2;

Function HexW(X: Word): String;

{Возвращает 16-ричное написание X} const

HS: array [0..15] of Char = '0123456789ABCDEF';

var

S: String; k: Byte;

begin

C; .= II. 0 . — /

for k := 3 downto 0 do

S := S+HS[(X shr (k*4)) and 15];

HexW := S end; {UexW} ^———\————————^

Procedure GetTime;

{Помещает в t системное время, выравненное на границу 55-мс интервала}


h0153.htm

begin

t := MemL[0:$46C] ;

while t=MemL[0:$46C] do;

end; {Get Time} _'————————.——;

begin {Основная программа} {Проверяем наличие EMM} If not IsEMS then begin

WriteLn('Нет ЕМЗ-памяти или не установлен EMM');

Halt end;

Colors(LightGray,Black);

CIrScr;

{Сообщаем номер версии, общую и доступную память} WriteLn('Используется EMM версии ',GetEMMVersion);

WriteLn(' Сегмент окна отображения $',HexW(EMSSeg));

GetEMSInfo(All,Pages) ;

WriteLn(' Всего страниц : ',А11,' (',

round(All*16.0*1024),' байт)');

Sz := round(Pages*16.0*1024);

WriteLn (' Свободно страниц: ',Pages,' (',Sz,' байт)');

{Определяем количество X 16-Кбайтных страниц в куче} х := MaxAvail div LPage;

if x>Pages then x := Pages; {Уравниваем с EMM} {Распределяем в куче массивы из 4096 длинных целых чисел} dec (х) ;

for k := 0 to x do

if MaxAvail>=LPage then GetMem(PV[k],LPage) ;

x := k;

Sz :==succ (x) *LPage div 4;

WriteLn('Создаем массив из ',Sz,

' длинных целых чисел в куче...');

GetTime; {Засекаем время} for j := 0 to x do

for k := 0 to LPage div 4-1 do begin

PVEjJ'^k] := j* (LPage div 4)+k;

if PVtjI'^k] mod 1000=0 then begin

Write (PVCjI^k:] :10);

GotoXY(l,WhereY) end end;

{Подсчитываем его сумму} WriteLn('Подсчитываем его сумму...');


h0154.htm

Sum := 0;

for j := 0 to x do

for k := 0 to LPage div 4-1 do begin

Sum := Sum+PV[j] •"[k] ;

if PV[j]л[k] mod 1000=0 then begin

Write (PVCjI^k] :10) ;

GotoXY(l,WhereY) end end;

WriteLn('Сумма элементов = ':30,Sum:11:0,',время счета = (MemL[O:$46C]-t)*55/1000:5:2,' секунд') ;

{Освобождаем кучу} for k : = 0 to x do

FreeMem(PV[k],LPage) ;

{Создаем массив в EMS} WriteLn('Тот же массив в EMS-памяти...') ;

Vec.Init(4,0,Sz-1); {4-длина элемента;..Sz-1 - индексы} if not EMSErrorFlag then with Vec do

begin (Если создан успешно} GetTime; {Засекаем время} for k := 0 to Sz-1 do begin

Setltem(k,k); {Помещаем очередной эл-т} if k mod 1000=0 then

begin {Сообщаем о каждом 1000-м} Write(k:10) ;

GotoXY(l,WhereY) end end;

{Вычисляем сумму элементов} WriteLn('Суммируем элементы...');

Sum : = 0 ;

for k := 0 to Sz-1 do begin

Sum := Sum+LongIntItemfk);

if k mod 1000=0 then

begin {Сообщаем о каждом 1000-м} Write(k:10) ;

GotoXY(l,WhereY) end end end else Halt;

WriteLn('Сумма элементов = ':30,Sum:11:0,', время счета =


h0155.htm

Доступ к отображаемой памяти 155

(MemL[O:$46C]-t)*55/1000:5:2,' секунд') ;

WriteLn('Сохраняем массив в файле TESTEMS.$$$...');

Assign(f,'testems.$$$');

{$!-} Rewrite(f,l) ;

{$!+} if IQResultoO then begin

WriteLn('Ошибка при создании файла!');

Vec.Done;

Goto LI end;

Vec.Store(f); {Сохраняем массив} if EMSErrorFlag then

begin {Была ошибка при сохранении} Vec.Done;

Goto LI end;

Vec.Done; (Освобождаем EMS} {Читаем массив из файла} WriteLn('Читаем массив из файла...');

Seek(f,0); {Начало файла} Vec.Load(f); {Загружаем массив} Close (f) ;

if EMSErrorFlag then

Goto LI; {Была ошибка} WriteLn('Еще раз подсчитываем его сумму...');

Sum : = 0 ;

for k := 0 to Sz-1 do begin

Sum := Vec.LongIntItem(k)+Sum;

if k mod 500=0 then begin

Write(k:10) ;

GotoXY(l,WhereY) end end;

WriteLn('Сумма = ':30,Sum:11:0);

Vec.Done;

LI:

{Определяем длину файла с текстом программы} s := copytParamStrtO^l/PosC.'/ParamStrtO^+'pas';

Assign (f,s);

Reset(f,l) ;

{Определяем количество SZ требуемых ему страница ST. := (FileSize(f)+LPage-l) div LPage;

Closed) ;


h0156.htm

Assign(ft,s) ;

Reset(ft) ;

{Создаем объект TEMSText}

WriteLn('Создаем объект TEMSText');

Тех.Init(Sz*Lpage) ;

if EMSErrorFlag then

Halt;

{Читаем файл и записываем его в TEMSText} WriteLn('Помещаем в него файл '+S);

while not (EOF(ft) or EMSErrorFlag) do

begin

ReadLn(ft,s); (Читаем строку} Тех.Setltem(s) {Помещаем ее в EMS}

end;

if EMSErrorFlag then

Goto L2;

{Проверяем записанное}

Reset(ft); {Начало файла} Tex.Pos := 0; {Начало текста в EMS} for k := 1 to 16 do

WriteLn; {Готовим место для окон} Colors(Yellow/Blue); {Цвет вывода} SetWindowd, 10, 80,23,1, 1 Исходный файл: '+

#196#196#196#196#196#196#196#196#196#196#196#196#196+

#196#196#196' Текст в EMS: ',True,False,False);

while not EOF(ft) do begin

ReadLn(ft,s);

ss := Tex.GetItem;

if Length(s)>38 then s[0] := #38;

While Length(s)<39 do s := s+' ';

s := s+ss;

if Length(s)>77 then s[0] := #77;

WriteLn(s) end;

Тех.Done;

Colors(LightGray,Black);

Window(1,1,80,25) ;

GotoXY(l,25) ;

L2:

{Проверка объекта TEMSScreen} Write('Сохраняем копию текстового экрана. ');

Scr.Init;

if not EMSErrorFlag then

Scr.PutScreen; {Сохраняем копию в EMS}


h0157.htm

if EMSErrorFlag then

Halt; {Была ошибка} x := WhereX; {Запоминаем положение курсора} WriteLn('Нажмите любую клавишу...') ;

if ReadKey=#O then k := ord(ReadKey);

{Создаем окно в центре экрана и заполняем его случайным цветом} CIrScr;

SetWindow(10,7,70,18,2,' Нажмите любую клавишу...', False/True,False);

while not KeyPressed do begin

GotoXY(Random(59)+2,Random(10)+2) ;

TextBackground(Random(8));

Write (' ') end;

if ReadKey=#0 then k :== ord(ReadKey);

Scr.GetScreen; {Восстанавливаем экран} Window(l,l,80,25) ;

TextBackground(Black) ;

GotoXY(x,25) ;

Scr.Done;

{Проверяем графический режим} WriteLn(#13#10'Для перехода в графический '+

"режим нажмите любую клавишу...');

if ReadKey=#0 then k := ord(ReadKey) ;

d := detect;

InitGraph(d,r,'') ;

e := GraphResult;

if e о 0 then

begin {Ошибка инициации графики} WriteLn(GraphErrorMsg(e)) ;

Halt end;

{Инициируем Scr заново - новый режим экрана!} Scr.Init;

Line(0,0,GetMaxX,GetMaxY); {Диагональные линии} Line(O,GetMaxY,GetMaxX,O) ;

Scr.PutScreen; {Сохраняем изображение}. while not (KeyPressed or EMSErrorFlag) do begin

ClearDevice; {Очищаем экран} Scr.GetScreen; {Восстанавливаем

изображение} end;

Scr.Done;

CloseGraph;

end.


h0158.htm

Глава 6

ЗАЩИТА ПРОГРАММ ОТ КОМПЬЮТЕРНЫХ ВИРУСОВ

В главе анализируется механизм распространения и функционирования вирусов в операционной системе MS-DOS и на основе анализа предлагаются достаточно эффективные способы борьбы с ними. Приводятся описания трех разных программ, обеспечивающих выявление и ликвидацию вирусов. Модуль F_Anti может использоваться для автоматической защиты вновь разрабатываемых Турбо Паскалевых программ. Программа AntiVir осуществляет выявление и ликвидацию загрузочных вирусов и контроль любых исполняемых файлов на основе сопоставления наиболее уязвимых для вируса частей файлов с их эталонными копиями. Наконец, комплекс программ SetFag.exe и Fag.prg даст Вам возможность установить антивирусную программу—фат на любой уже созданный ЕХЕ—ф&ил: в момент запуска программы фаг проверит ее состояние, если программа поражена вирусом, сообщит об этом и удалит вирус.

6.1. ЧТО ТАКОЕ КОМПЬЮТЕРНЫЕ ВИРУСЫ

Если Вы имеете опыт продолжительной работы с ПК, то, возможно, уже сталкивались с компьютерными вирусами или хотя бы слышали о них. Компьютерный вирус — это программа, производящая в Вашем ПК действия, в которых Вы не нуждаетесь и о которых не подозреваете. Главной ее особенностью является способность к «размножению», т.е. к созданию множества готовых к дальнейшей работе экземпляров вируса. Вирусы «цепляются» к обычным исполняемым файлам типа .ЕХЕ, .СОМ или к загрузочным секторам физических носителей информации (дискет) и таким образом перемещаются от одного ПК к другому.

Являвшиеся первоначально вполне невинным развлечением скучающих программистов компьютерные вирусы сегодня стали настоящим бедствием для пользователей ПК: количество и типы таких программ растут с ужасающей скоростью, а сами вирусы в ряде случаев приобрели весьма неприятные свойства — некоторые из них способны уничтожать файловую структуру дисков со всеми катастрофическими для пользователя последствиями. В литературе [14] описывается беспрецедентный случай, когда вирус на три дня (с 2 по 4 ноября 1988 г.) вывел из строя фактически всю компьютерную сеть США. Были парализованы компьютеры Агентства национальной безопасности, Стратегического командования ВВС США, локальные сети всех крупных университетов и исследовательских центров. Лишь в последний момент удалось спасти систему управления полетом космических кораблей Шаттл. Положение было настолько серьезным, что к расследованию немедленно приступило ФБР. Виновником катастрофы, причинившей ущерб более чем в 100 миллионов долларов, оказался студент выпускного курса Корнеллского университета Р.Моррис, придумавший достаточно хитрую разновидность вируса. Он был исключен из университета с правом восстановления через год и приговорен судом к уплате штрафа в 270 тысяч долларов и трем месяцам тюремного заключения.


h0159.htm

Защита программ от компьютерных вирусов 1^9

Трудно объяснить, для чего программисты тратят силы и время на создание все более изощренных типов вируса, поскольку их авторы почти всегда остаются или надеются остаться анонимными, так что естественное для человека стремление к известности здесь исключено. Может быть это неудачная шутка (этой версии придерживался Р.Моррис), возможно это связано с патологическими отклонениями в психике, а может быть объяснение кроется в стремлении заработать на создании антивирусных программ? Как бы там ни было, нам нельзя не считаться с возможностью заражения ПК компьютерным вирусом.

6.2. ЦИКЛ ФУНКЦИОНИРОВАНИЯ ВИРУСОВ

В цикле существования любого вируса можно выделить три этапа. Первоначально вирус находится в неактивном состоянии. В этом состоянии он внедрен в тело исполняемого файла или находится в загрузочном секторе диска и «ждет» своего часа. Именно в неактивном состоянии вирусы переносятся вместе с программами или дискетами от одного ПК к другому (обмен программами между пользователями ПК — явление обыденное, и Вы сами, читатель, возможно копировали полюбившуюся Вам игру или текстовый редактор, не подозревая, что копируете еще и вирус). Разумеется, в неактивном состоянии вирус ничего не может сделать. Для того чтобы он начал свою работу, необходимо запустить исполняемый файл или загрузиться с зараженной дискеты. В этот момент активизируется вирус, который либо создает резидентную в памяти программу, способную порождать копии или производить какие—то разрушительные действия, либо немедленно приступает к работе.

Если вирус создал резидентную программу, то ее активизация осуществляется различными способами — все зависит от фантазии автора вируса. Обычно вирус перехватывает прерывание $21, являющееся ключевым для доступа к любым операциям с MS-DOS. Таким образом, любая попытка чтения или записи информации на диск или обращение к клавиатуре ,г\исплея приводит к активизации резидентной программы вируса.

После получения управления (или активизации резидентной программы) вирус приступает к «размножению»: он отыскивает подходящий исполняемый файл и внедряет свой код в его тело (см. ниже). Как правило, вирус заражает лишь один исполняемый файл за раз, чтобы пользователь не обратил внимания на чрезмерное замедление в работе программ: второй этап жизнедеятельности вируса — это этап активного размножения, поэтому вирусная программа стремится максимально скрыть от пользователя ПК результаты своей деятельности.

После того как заражено достаточно много файлов, может наступить третий этап, связанный с внешними проявлениями работы вируса. Ваш компьютер вдруг начнет вести себя странно: зазвучит ли музыкальная фраза, или начнут «сыпаться» символы на экране дисплея — не суть важно, главное, что только в этот момент Вы с ужасом вспомните, что на жестком диске находятся чрезвычайно важные для Вас данные или программы, которые Вы не успели или не смогли скопировать на дискеты. Увы! Некоторые вирусы к этому моменту могут уже безвозвратно нарушить файловую структуру.

Что делать при обнаружении вируса? Прежде всего не паниковать, ведь далеко не все вирусы отличаются «кровожадностью». Следует выключить компьютер, вставить в привод гибкого диска заранее припасенную эталонную


h0160.htm

системную дискету (никогда не снимайте с нее защиту!) и снова включить компьютер. Если на ПК имеется специальная кнопка для перезагрузки (RESET или INIT), можно использовать ее и не выключать/включать компьютер, но во всех случаях не пытайтесь перезагрузиться с помощью Ctrl-Alt-Del: от некоторых типов вируса Вы не избавитесь таким образом. Затем нужно запустить какую-либо программу—антивирус (например, AIDSTEST Д.Н.Лозинского) и с ее помощью локализовать и удалить вирус. Если антивирусная программа не может обнаружить вирус или у Вас под рукой нет такого рода программ, еле — дует попробовать обратиться к нужному Вам жесткому диску и, если это удастся сделать, скопировать все наиболее ценное (но только не исполняемые файлы!) на дискеты. После этого заново переформатировать жесткий диск, перенести на него эталонную копию ДОС и восстановить с дискет то, что удалось спасти.

6.3. «ВАКЦИНАЦИЯ» ПРОГРАММ

Что же следует сделать, чтобы эта безрадостная картина не стала реальностью? Один ответ очевиден — периодически (и по возможности чаще) сохранять жизненно важные для Вас результаты работы на дискетах. Нет ничего проще, чем дать этот совет, гораздо сложнее заставить себя следовать ему: я сам, честно говоря, далеко не каждый день трачу время на архивирование. Второй ответ менее очевиден. С его простой идеей я впервые познакомился в прекрасной статье Ф.Н.Шерстюка [38].

Вот эта идея: нужно произвести «вакцинацию» исполняемых программ, т.е. придать им свойство самодиагностики, позволяющее произвести контроль собственного файла и выяснить, заражен он или нет. Если факт заражения установлен, программа может попытаться восстановить свой исходный вид, т.е. удалить прицепившийся к ее файлу вирус. Если эту идею последовательно воплощать в жизнь, то большинство Ваших программ приобретет стойкий «иммунитет» к вирусам, во всяком случае, они смогут достаточно быстро сообщить Вам о факте заражения.

Преимущества этой идеи очевидны: в отличие от разработчиков многочисленных антивирусных программ, которые борются с конкретными разновидностями вирусов, Вы можете сохранить в файле программы некоторую ключевую информацию о ее незараженном виде, и поэтому факт заражения любым видом вируса может быть легко установлен в момент запуска Вашей программы.

6.3.1. Заголовок исполняемых файлов

Какую именно информацию о незараженном файле следует сохранять? Для ответа на этот вопрос необходимо знать соглашение ДОС о формате исполняемых файлов. Как известно, существуют два формата: СОМ и ЕХЕ. Любая программа, обрабатываемая системой Турбо Паскаль версии 4.0 и выше, может быть оттранслирована только в ЕХЕ—фа&л, поэтому все дальнейшие рассуждения относятся именно к этому формату.

В начале ЕХЕ— файла располагается заголовок, в котором содержится вся информация, необходимая для преобразования дискового файла в готовую к работе программу. Первые 28 байт заголовка соответствуют следующей структуре данных:

type


h0161.htm

HeadExeType = record

Sign Word; {Признак ЕХЕ-файла} PartPag Word; {Часть неполного сектора в конце файла} PageCnt Word; {Количество секторов, включая неполный} ReloCnt Word; {Количество элементов

в таблице перемещения} HdrSize Word; {Длина заголовка в параграфах} MinMem Word; {Минимальный размер кучи (в параграфах)} MaxMem Word; {Максимальный размер кучи (в параграфах)} ReloSS Word; {Начальное значение сегмента стека SS} ExeSP Word; {Начальное значение указателя стека SP} ChkSum Word; {Контрольная сумма всех слов файла} ExelP Word; {Смещение точки запуска программы} ReloCS Word) {Начальное значение сегмента кода CS};

TablOff Word; {Смещение первого элемента

таблицы перемещения} Overlay Word; {Номер оверлея или 0 для

основной программы)

end; {HeadExe}

Остальные элементы заголовка содержат так называемую таблицу перемещения, предназначенную для настройки адресов загруженной программы. Таблица начинается с байта TablOff от начала файла и содержит ReloCnt четырехбитных элементов следующего вида:

type

ReloTablItem = record

ItemSeg: Word; {Сегмент перемещаемого адреса} ItemOfs: Word; {Смещение перемещаемого адреса)

end;

Признак ЕХЕ— файла хранится в поле Sign в виде символов «MZ» (код $5A4D) — с этого признака должен начинаться любой ЕХЕ—файл. Поле HdrSize содержит длину всего заголовка в параграфах (участках памяти длиной по 16 байт каждый). Поля PartPag и PageCnt определяют общую длину загружаемой в память части ЕХЕ— файла по следующей формуле:

L = (PageCnt-1)*512 + PartPag - HdrSize*16

Остальная часть файла (длина ЕХЕ— файла может быть больше L+HdrSize*16) при загрузке программы не учитывается. Обычно в остатке файла, созданного системой Турбо Паскаль, (если, разумеется, есть остаток) содержится информация, используемая встроенным отладчиком, или оверлеи.

Подавляющее большинство ЕХЕ— вирусов пристыковывает свою программу в конец файла, а для того чтобы эта программа была загружена в память и ей было передано управление, изменяет поля PartPag, PageCnt, ReloCS, ExelP 1адрес точки, куда передается управление после окончания загрузки) и, возможно, некоторые другие поля. При таком способе внедрения общая длина загружаемой в память части файла должна составлять

ExeSize => FileSize + VirusSize,

•-де FileSize — полная длина ЕХЕ— файла, a VirusSize — длина программы ви руса. Так как в остатке фала могут храниться оверлеи (или архив для сам>- —


h0162.htm

разгружающихся архивных программ), длина ExeSize может оказаться чрезмерно большой, так что программа не сможет загрузиться в память или не сможет работать нормальным образом. Некоторые безграмотно написанные вирусы не учитывают это обстоятельство и быстро выдают себя, т.к. зараженные программы перестают работать.

Другой способ внедрения вируса — пристыковка кода вируса до начала загружаемой части программы и сразу за заголовком файла (см. рис.6.1).

а) б) в) L - загружаемая в память часть файла

Рис.6.1. Варианты внедрения вируса в тело файла: а) незараженный файл; б) вирус в конце файла;

вирус в начале файла; в) вирус в середине файла

Такой способ внедрения позволяет не загружать в память весь ЕХЕ—фа&л, а длина загруженной программы увеличивается только на мину кода вируса. Несмотря на кажущееся преимущество такого способа, он используется достаточно редко. Его реализация значительно сложнее, так как перед передачей управления основной программе вирус должен перенести 256 байт префикса программного сегмента (Р5Р) в конец собственного кода так, чтобы они непосредственно предшествовали телу программы — в противном случае будет нарушена важная связь программы с PSP или относительная адресация в самой программе. Кроме того, в процессе заражения он должен увеличить на величину VirusSize поле ItemOfs каждого элемента таблицы перемещения и абсолютного адреса, указываемого этим элементом. В отличие от стандартного загрузчика ДОС вирусу приходится корректировать не загруженную программу, а ее файловый образ. Так как в ЕХЕ— программе средней сложности может бытп несколько сотен элементов таблицы перемещения, процесс настройки таблицы вирусом приводит к заметному увеличению времени запуска программы, что может обнаружиться пользователем. На этапе размножения вирусы стремятся по возможности скрыть от пользователя результат своей


h0163.htm

Защита программ от компьютерных вирусов , 163

деятельности, поэтому ЕХЕ— файлы редко поражаются вирусами, пристыко— ванными в начало файла.

Разумеется, существует возможность внедрения вируса непосредственно в тело исполняемой программы. Однако на практике это почти всегда означает разрушение логики работы программы, поэтому такой вирус немедленно обнаруживается.

Анализ сказанного позволяет сделать важный вывод: практически любой существующий вирус (или вирус, который еще только будет создан!), рассчитанный на поражение ЕХЕ— файла, пристыковывает свой код в конец файла и изменяет его заголовок. Следовательно, для контроля факта заражения программы и ликвидации вируса необходимо где-то сохранить заголовок файла и его эталонную длину и периодически сопоставлять действительный заголовок и длину с эталонными значениями. При этом следует учитывать то обстоятельство, что некоторые вирусы контролируют любое обращение к дисковым секторам, в которых расположена их программа, и «подсовывают» незара— женные копии этих секторов. Такие вирусы (их называют вирусы — невидимки) вряд ли удастся обнаружить с помощью стандартного обращения к функциям ДОС. Для борьбы с ними используют прямое обращение к BIOS— прерыванию $13 подобно тому, как это реализовано в программе ANTIVIR (см. п.6.3.6).

6.3.2. Защита вновь создаваемых программ

Ключевую информацию (будем для краткости называть ее ключ) о неза— раженной программе можно хранить в отдельном файле, но в этом случае существует опасность потерять дополнительный файл при копировании программы или ошибочно уничтожить его. Гораздо надежнее хранить ключ в теле самого защищаемого файла. К сожалению, его нельзя подобно вирусу при— стыковать в конец файла, т.к. в случае заражения вирус изменит поля PartPag и PageCnt и мы никогда не сможем определить то место в файле, где он располагается. Вспомним, что все константы (в том числе и типизированные) создаются на этапе компиляции программы, таким образом в файле обязательно имеется область данных, содержащая значения этих констант. Эта область в Турбо Паскалевых программах располагается в самом конце загружаемой части файла (см.рис.6.2).

Следовательно, мы должны объявить в программе типизированную константу, предназначенную для хранения ключа, а затем в область файла, отведенную для ее размещения, поместить нужную информацию.

Каким образом отыскать в ЕХЕ— файле место, занимаемое ключом? Конечно, можно перед ним в программе разместить какую-либо типизированную константу с характерным значением (например, заранее обусловленную текстовую строку) и затем отыскивать ее в файле. Однако такое решение вряд ли можно признать удовлетворительным: во-первых, всегда существует вероятность того, что какой-то фрагмент кодов программы содержит ту же цепочку байт, что и заголовок ключа; во-вторых, придется просматривать подчас большой по объему ЕХЕ—файл в поисках нужной константы. Значительно изящнее выглядит решение, основанное на точном вычислении смещения от начала файла до ключа.


h0164.htm

Младшие адреса

Рис.6.2. Распределение памяти для загруженной программы

Для этого нужно определить начало области данных в файле. В заголовке файла не предусмотрено никакой информации о начальном значении регистра DS, в котором хранится сегмент данных. Перед передачей управления программе загрузчик устанавливает значение этого регистра так, чтобы он указывал на начало так называемого префикса программного сегмента [PSP}, а запущенная программа уже сама должна установить его надлежащим образом.

Префикс программного сегмента имеет длину 256 байт (16 параграфов) и размещается загрузчиком в оперативной памяти непосредственно перед загруженной программой. В PSP содержится различная служебная информация, которая может быть достаточно важной для ДОС и работающей программы (в PSP, например, хранятся параметры обращения к программе), но в нем нет указаний на содержимое регистра D5. Таким образом, найти начало области данных в файле достаточно трудно. Однако это нетрудно сделать в работающей программе — для этого предусмотрена стандартная функция DSegr, возвращающая сегмент данных. Если бы программа могла получить также информацию о сегменте PSP, с которого начинается загруженная программа, можно было бы вычислить смещение в файле от его начала до начала области данных. Такая возможность есть — функция MS-DOS с номером $62 возвращает в регистре ВХ значение сегмента Р5Р. Следовательно, программа должна получить значения обоих сегментов, вычислить их разницу и таким образом определить место в файле, с которого начинается область данных.

Остается последняя проблема — как найти нужную константу. Турбо Паскаль размещает константы в области данных по мере их объявления в


h0165.htm

программе. Зная размер каждой константы и порядок их объявления, можно вычислить место размещения нужной нам типизированной константы. Однако этот метод не годится для универсальной программы защиты, так как порядок объявления констант может меняться от программы к программе. К счастью, мы можем использовать операцию получения адреса @. Результатом применения этой операции к адресу константы, выбранной в качестве ключа, является указатель (четырехбайтный адрес); смещение адреса, который он содержит, и является нужным нам смещением начала ключа относительно начала области данных.

6.3.3. Модуль F_Anti

В этом параграфе описывается модуль F_Anti, в котором осуществляются все необходимые действия по установке ключа во вновь создаваемый ЕХЕ— файл и последующей проверке этого ключа при каждой загрузке программы. Полный текст модуля см. прил.П7.

В качестве ключа для контроля факта заражения ЕХЕ— файла в модуле F_Anti используется типизированная константа Head, соответствующая такой структуре данных:

type

НТуре = record

НЕ : HeadExeType; {Эталонный заголовок файла) HL : LongInt; {Эталонная длина файла} HF : Boolean; {Флаг установки ключа} Key: Word {Шифр для защиты ключа} end;

При создании этой типизированной константы компилятор в поле HP no — мещает значение False. Запущенная программа анализирует это поле. При первом прогоне HF = False, в результате чего программа вызывает процедуру Save. в ходе выполнения которой в файле сохраняются эталонный' заголовок и начальная длина файла. При этом одновременно в поле HF (в файле программы!) помещается значение True, поэтому при любом последующем запуске программы вместо Save будет вызвана процедура CheckFile, которая осуществит нужный контроль файла. Если в ходе контроля обнаруживается хотя бы малейшее отличие заголовка файла от его эталона, хранящегося в Head, программа сообщает о факте заражения и предлагает восстановить испорченный заголовок и начальную длину файла.

При восстановлении зараженного файла осуществляются следующие действия:

• зараженный файл копируется в файл с расширением VIR — это позволит Вам в случае неудачной попытки восстановления повторить ее еще раз;

кроме того, при желании Вы сможете передать разработчикам антивирусных программ копию вируса для выработки методов его обнаружения и уничтожения;

• анализируется адрес запуска зараженной программы: если относительное значение сегмента точки запуска у зараженной программы меньше, чем в эталоне, то это означает, что вирус располагается в начале или в сере—

' Если программа запускается на уже зараженном ПК. не исключено, что заголовок файла будет испорчен вирусом, и тогда система защиты будет ревностно следить за сохранностью вируса!


h0166.htm

дине файла; в этом случае программа предупреждает пользователя о невозможности восстановления (если Вас заинтересовал описываемый способ борьбы с вирусами, попробуйте модифицировать программу защиты таКг чтобы она работала и в этом случае);

• если вирус пристыкован в конец файла, то в восстанавливаемый файл переносится эталонный заголовок и незараженная часть, начиная с байта TabIOff + ReIoCnt'4 от начала файла и до байта FileSize — HL. Отмечу следующее обстоятельство. Описанная система защиты дублирует заголовок файла в тело программы. Ничто не мешает вирусу проверить тело программы на наличие дубликата и соответствующим образом изменить его. Я далек от мысли, что Вы, уважаемый читатель, после знакомства с этим разделом захотите создать собственный вирус, учитывающий это обстоятельство. Тем не менее я считаю, что нелишней будет какая—то защита самого ключа. Такая защита реализуется очень просто: для этого достаточно все 16-битные поля эталона заголовка сложить по модулю 2 со случайной константой Key. С этой целью в процедуру Save помещен следующий фрагмент (см. текст модуля в прил.П7):

{Зашифровать ключ:} Randomize;

Head.Key := Random($FFFF);

with Head,Head.HE do for k := 1 to 14 do

Hem[k] := HE.Hem[k] xor Key;

(массив Нет совмещен в памяти с сохраняемым в файле эталонным заголовком, a HE.Hem — с заголовком файла в момент первого запуска).

Инициация генератора случайных чисел с помощью процедуры Randomize гарантирует, что шифр Head.Key не будет повторяться в различных программах В процедуре CheckFile с помощью операторов

{Дешифровать ключ:} with H,H.HE do

for k :" 1 to 14 do

Hem[k] := Hem[k] xor Key;

восстанавливается исходный вид ключа.

Процедура CheckFile, осуществляющая установку или контроль ключа, вызывается в ходе выполнения установочной части модуля F_Anti, поэтому для использования описанного метода защиты достаточно указать имя модуля в предложении Uses. Замечу, что в случае разработки программы с оверлеями модуль F_Anti можно объявить оверлейным, если в установочной части любого неоверлейного модуля инициируется работа администратора оверлея.

В распоряжении программиста имеется глобальная переменная CheckVirusResult, сигнализирующая о результатах проверки программы. Значения этой переменной интепретируются следующим образом:

0; {Не обнаружен факт заражения} 1; <Первый запуск, в программе установлена защита}

-1; {Вирус обезврежен с согласия пользователя}

-2; {Вирус обезврежен автоматически}

-3; {Контроль подавлен ключом /NOANTI}

-<i; {Вирус расположен в начале программы!


h0167.htm

Защита программ от компьютерных вирусов 167

Работа процедуры CheckFile может быть подавлена, если программа запускается с ключом /NOANTI. Ключ /NOQUERY разрешает автоматическое удаление обнаруженного вируса без разрешения пользователя. Ключ /NOALARM также разрешает процедуре автоматически удалить вирус, но запрещает выдавать на экран предупреждающее сообщение. Наконец, ключ /NOCOPY запрещает создание резервной копии зараженного файла (с расширением VIR).

Следующая простая программа иллюстрирует технику использования модуля F_Anti. Если Вы скомпилируете эту программу в файл testanti.exe, то после команды

testanti на экране появится сообщение

Установлена защита файла TESTANTI.EXE. при первом запуске программы и

В файле TESTANTI.EXE вирус не обнаружен.

при каждом следующем запуске.

Если запустить программу командой

testanti /noanti на экран будет выведено сообщение

Контроль блокирован ключом /NOANTI.

Uses F_Anti;

begin

case CheckVirusResult of

0 WriteLn('B файле ',ParamStr(0),' вирус не обнаружен.');

1 WriteLn('Установлена защита файла ',aramStr(0),'.');

-1 WriteLn('Вирус удален с разрешения пользователя.');

-2 WriteLn('Вирус удален автоматически.');

-3 WriteLn('Контроль блокирован ключом /NOANTI.')?

-4 WriteLn('Вирус расположен в начале '+

'файла - удаление невозможно.') end end.

6.4. ЗАЩИТА СУЩЕСТВУЮЩИХ ЕХЕ-ФАЙЛОВ

Итак, «вакцинация» вновь разрабатываемых программ не представляет особой сложности. А как защитить уже существующую ЕХЕ— программу? Для этого существуют две возможности: либо использовать отдельную программу, которая хранит ключевую информацию и осуществляет проверку по требованию пользователя (такая программа обсуждается в следующем разделе), либо пристыковать к защищаемой программе небольшой код «вирусного фага» — тогда проверка будет осуществляться автоматически при каждом запуске программы. В этом разделе мы обсудим технику создания и внедрения в защищаемую программу антивируса—фага, т.е. небольшой ассемблерной про—


h0168.htm

граммы, которая использует тот же механизм перехвата управления, что и обычный вирус, но осуществляет нужную защиту программы.

Программа—фаг устанавливается специальной программой—установщиком и к моменту начала своей работы уже должна иметь в своем распоряжении эталонный заголовок файла. Получив управление, фаг проверяет заголовок соответствующего файла и, если обнаружены изменения, сообщает об этом пользователю и удаляет вирус. После окончания работы фаг передает управление защищаемой программе. Поскольку фаг пишется целиком на ассемблере, его работа протекает очень быстро без заметного замедления загрузки программы. Если Вы установите такой фаг на большую часть часто используемых программ, Ваш компьютер будет защищен очень надежно.

Чтобы правильно спроектировать фаг, нужно хорошо представлять себе механизм запуска ЕХЕ— программ. Стандартный загрузчик ДОС реализует следующую последовательность действий при запуске программы.

1) Создается префикс программного сегмента PSP. Обычно для этого используется функция ДОС $26.

2) В некоторую локальную область памяти считываются начальные 28 байт заголовка ЕХЕ— файла, соответствующие структуре данных HeadExeType.

3) Определяется размер загружаемой части файла по формуле

LengExe = (PageCnt-1)*512 + PartPag

4) Определяется файловое смещение загружаемой части:

SeekExe == HdrSize*16

5) Выбирается сегментный адрес StartSeg для размещения программы. Обычно StartSeg = Segment (PSP)+ 16, т.е. программа размещается сразу за PSP, который имеет длину 256 байт (16 параграфов).

6) Считывается загружаемая часть программы в непрерывную область памяти длиной LengExe, начинающуюся по адресу StartSeg-.OOOO.

7) Указатель файла устанавливается на начало таблицы перемещения TablOff.

8) Для каждого элемента перемещения (этих элементов ReloCnt]:

• считывается элемент как два 16-битных слова ItemOfs, ItemSeg;

• вычисляется ReloSeg = StartSeg+ItemOfs, т.е. сегментная часть смещения абсолютного адреса перемещаемой ссылки;

• извлекается слово по адресу ReloSeg'.ItemOfs — сегментная часть перемещаемой ссылки;

• к этому слову прибавляется StartSeg (осуществляется так называемая привязка сегмента);

• результат помещается обратно по адресу ReloSeg-.RemOfs.

9) Выделяется память за концом программы в соответствии со значениями MinMem и МохМеш.

10) Инициируются регистры и запускается программа:

• регистры ES и DS получают значение сегмента, в котором располагается PSP;

• регистр АХ отражает корректность идентификаторов дисков в командной строке (при нормальном запуске содержит 0);

• 5S= StartSeg+ReloSS;

• SP == ExeSP:


h0169.htm

• CS = StartSeg+ReloCS;

• IP = Exelp;

• содержимое остальных регистров не имеет значения. Регистры сегмента кода CS и указателя инструкций IP обычно инициируются следующими тремя командами:

PUSH StartSeg+ReloCs

PUSH Exelp

RETF

(команда RETF дальнего возврата из подпрограммы извлекает из стека два слова — смещение и сегмент адреса перехода — и помещает их соответственно в IP и CS).

Таким образом, сразу после получения управления фаг должен сохранить значения регистров АХ и DS и поместить в DS значение собственного сегмента данных. На практике сегмент данных в коротких ассемблерных программах обычно совпадает с сегментом кода, т.е. программа и данные размещаются в одном сегменте. Сегмент стека 55 можно не изменять, т.к. программа-установщик фага должна позаботиться о том, чтобы стек не разрушил код самого фага, и соответствующим образом настроить ReloSS и/или ExeIP. Обычно в ЕХЕ— программе начальное значение ReloSS таково, что стек размещается сразу за концом программы, т.е. в том месте, куда программа-установщик помещает код фага. Длина стека ExeSP как правило более чем достаточна для того, чтобы работа фага со стеком не привела к разрушению кода фага, поэтому в большинстве случаев установщик оставляет начальные значения ReloSS и ExeSP без изменения.

6.4.1. Описание программ SetFag.pas и Fng.asm

В этом параграфе описываются программы SetFag.pas и Fag.asm, с помощью которых реализуется описанный выше механизм защиты. Программа SetFag (прил.П8.1) осуществляет установку фага, а программа Fag.asm (прил.П8.2) содержит сам фаг. Если Вы захотите воспользоваться предлагаемыми программами, откомпилируйте Турбо Ассемблером файл Fag.asm командой

tasm fag /L

В ходе компиляции на экран будет выведено 13 предупреждений вида *Warning* Open procedure: XXXXXX

а в конце — сводка

Error message: None Warning message: 13 Passes: 1 Remainig memory: XXX К

Если в строке Error message вместо None указано число обнаруженных ошибок, просмотрите файл листинга компиляции fag.Ist, отыщите в нем сообщения компилятора об ошибках и устраните их. Затем преобразуйте полученный файл fag.obj в программу Fag.prg командой

tlink fag, fag.prg


h0170.htm

Компоновщик должен сообщить

Warning: No stack

Замечу, что программа Fag.prg не может работать самостоятельно без предварительной настройки установщиком SetFag.exe, поэтому в целях предосторожности ей присваивается нестандартное расширение PRG.

Для установки защиты на любой ЕХЕ—фа&л.1 следует дать команду

setfag NAME

где NAME — имя защищаемого файла. Иными словами, имя файла передается программе установки фага SetFag.exe с помощью параметров запуска. В имени NAME можно опускать стандартное расширение ЕХЕ, а также разрешается указать маршрут поиска файла и/или символы—заменители ДОС «'» и«?» для определения группового имени — в этом случае защита будет установлена на каждый файл, соответствующий групповому имени. Например, команда

setfag d:\mydir *

означает требование установить защиту на все ЕХЕ— файлы из каталога MYDIR на диске D.

Перед установкой зашиты программа осуществляет серию проверок файла. Она проверяет заголовок файла и блокирует установку защиты, если первые два байта заголовка не соответствуют сигнатуре vMZ» (признаку ЕХЕ— файла). Кроме того, она проверяет «хвост» файла с тем, чтобы убедиться в отсутствии кода фага, и блокирует повторную установку защиты на уже защищенный файл. Далее, защита не устанвливается также в том случае, если длина загружаемой части файла станет слишком большой (превысит доступную память). Если в конце файла обнаружена незагружаемая часть, программа информирует об этом пользователя и запрашивает у него подтверждение на установку защиты. После завершения всех проверок программа создает резервную копию исходного файла с расширением ВАК. Создание ВАК— файла можно запретить, если команду вызова дополнить ключом /NOBAK, например

setfag rayprog /nobak Для защиты используется ключ, соответствующий такой структуре данных:

type

HeadType = record case Byte of

1: (

Sign Word {Сигнатура 'MZ' = $5A4D} PartPag Word {Часть неполного сектора} PageCnt Word {Количество 'секторов} ReloCnt Word {Количество элементов в

таблице перемещения} HdrSize Word {Длина заголовка в параграфах} MinMem Word {Минимальный размер кучи} MaxMem Word {Максимальный размер кучи}

' Разумеется, фаг нельзя устанавливать на файлы, защищенные средствами модуля F_Anti (см. п.6.3.2), так как в этом случае процедура CheckFile этого модуля обнаружит изменение заголовка и удалит фаг. Кроме того, фаг пристыковывается в конец программы и, следовательно, не может защищать крупные программы. Последнее обстоятельство контролируется установщиком SetFag,


h0171.htm

ReloSS : Word; {Начальное значение сегмента стека SS} ExeSP : Word; {Начальное значение указателя стека SP) ChkSum : Word; {Контрольная сумма всех слов файла} ExelP : Word; {Смещение точки запуска программы} ReloCS : Word; {Начальное значение сегмента кода CS}) ;

2:(W: array [1..12] of Word)

end;

TAVir = record

Head24: HeadType; {24 байта эталонного заголовка} Starts: Word; {Относительный сегмент} StartO: Word; {и смещение точки запуска программы} Leng24: Longint; {Длина незараженной

программы минус 24 байта} Key : Word; {Ключ шифровки}

end;

Как видим, этот ключ несколько отличается от использованного в модуле F_Anti: сохраняются только 24 байта заголовка (вряд ли вирус изменит смещение таблицы TablOff и номер оверлея Overlay}, исключено ненужное теперь поле HF, добавлены поля StartS и StartO мя запоминания относительного адреса точки запуска защищаемой программы. Поле Key по—прежнему содержит шифр для защиты ключа. Суммарная длина ключа SizeOf {TAVir} составляет 34 байта.

Процесс установки защиты состоит из следующих этапов.

1) В динамическую память считывается код фага из файла FAG.PRG. Вы можете создать свой вариант фага и заставить программу SetFag использовать его, если в команду запуска установщика добавите ключ /F: NameFag.Ext, где NameFag.Ext — имя и расширение файла, содержащего разработанный Вами фаг. В этом случае учтите, что SetFag помещает 34—байтный ключ в самое начало кода фага (см. листинг FAG. ASM) и поэтому при считывании из файла пропускает 34 байта от начала его загружаемой части. Выделение кода фага в отдельный P^G—файл понадобилось мне на этапе разработки и отладки кода фага. Я решил сохранить возможность загрузки кода из внешнего файла для того, чтобы Вы смогли при желании поэкспериментировать с этим кодом.

2) В поле Head24 переменной НН типа TAVir считывается заголовок ЕХЕ-файла и осуществляется настройка ключа НН: в полях StartS и StartO запоминается относительный адрес точки запуска защищаемой программы; вычисляется файловое смещение LS в параграфах, соответствующее полной длине файла и выровненное на границу параграфа — с этим смещением от начала файла в него будет помещен ключ и тело фага (выравнивание на границу параграфа необходимо для того, чтобы обеспечить корректность внутрисегментной адресации кода фага); в ReloCS помещается новое значение относительного сегмента точки запуска фага, а в ExelP — смещение этой точки;

рассчитывается новое значение длины загружаемой части файла с учетом ключа и тела фага и соответствующим образом изменяются поля PageCnt и PartPag; проверяются и при необходимости корректируются поля MinMem и ExeSP так, чтобы стек не разрушил код фага.

3) В начало ЕХЕ— файла записывается новый заголовок HH.Head24, затем осуществляется смещение файлового указателя на LS' 16 байт от начала файла и в него записывается зашифрованный ключ и тело фага.

Ассемблерная программа FAG. ASM. работает следующим образом.


h0172.htm

Сразу после получения управления фаг сохраняет в стеке регистр АХ, запоминает в переменной PSP значение регистра сегмента данных D5 (в этот момент он указывает на префикс программного сегмента) и помещает в DS. сегмент кода CS (данные и код фага расположены в одном сегменте). Кроме того, в переменной SPO запоминается вершина стека, а в CSO — сегмент кода фага. Затем вычисляется абсолютный сегмент точки запуска защищаемой программы (как уже говорилось, он равен PSP+16) и найденное значение помещается в StartS — таким образом готовится запуск защищаемой программы.

Вся основная работа фага запрограммирована в серии последовательно вызываемых процедур (при разработке фага использовался метод нисходящего программирования). Вначале с помощью процедуры GetExeName фаг определяет полное имя защищаемого ЕХЕ— файла. Для этого используется то обстоятельство, что в версиях ДОС 3.0 и выше стандартный загрузчик помещает полное имя загружаемого файла в расширенное окружение ДОС. Окружение ДОС — это область памяти длиной до 32 Кбайт, в которой ДОС сохраняет переменные окружения типа COMSPEC, PATH, PROMPT и т.п. Каждая переменная окружения представляет собой текстовую строку, составленную из кодов ASCII, в конце которой ставится байт 0 как признак конца строки — фирма IBM называет такой код ASCIIZ [Z — Zero, ноль). Переменные окружения располагаются в памяти последовательно друг за другом. В конце «стандартной» части окружения (эта часть поддерживается и в ранних версиях ДОС) ставится дополнительный нулевой байт. За стандартной частью следует расширенная часть, куда загрузчик новых версий ДОС помещает полное имя файла (с указанием диска и маршрута поиска) и, возможно, параметры обращения к программе. Таким образом, чтобы найти имя файла, нужно отыскать в окружении ДОС два ноля подряд — это признак начала расширенной части окружения. Слово, следующее за этим признаком, содержит количество переменных в расширенной части, за ним помещаются сами переменные. Например, в терминах ассемблера структура окружения может быть такой:

db 'COMSPEC=C:\COMMAND.COM',0 ;Переменная COMSPEC db 'PATH=C:\;C:\DOS;D:\TP',0 ;Переменная PATH db 'PROMPT=$p$g',0 ;Переменная PROMPT db 0 ;Признак конца

В этом месте кончается стандартная часть окружения и начинается его расширенная часть (только для ДОС 3.0 и выше!).

dw 2 ;Количество переменных в расширенной части

db 'D:\MYDIR\SETFAG.EXE',0 ;Имя файла

db '/NOBAK',0 ;Параметр вызова

Перед передачей управления программе загрузчик копирует окружение в отдельную область памяти и помещает сегмент этой области в PSP (в слово со смещением 44 байта от начала PSP}.

В заключение следует сказать, что программы SetFag и Fag.asm не являются эталоном. Просто мне показалось, что такой способ организации защиты ЕХЕ— файлов будет достаточно удобным в использовании и эффективным в работе. Действительно, тестовые заражения программ специально разработанным вирусом, а также вирусом Yankee показали, что фаг успешно выполняет свои функции.


h0173.htm

Защита программ от компьютерных вирусов 173

Поскольку программу Fag.asm без особого труда можно изменить, существует потенциальная опасность, что этот материал может быть использован для разработки вирусов. Я очень надеюсь, что к Вам, уважаемый читатель, это не относится.

6.4.2. Программа AntiVir

Итак, мы рассмотрели способ, позволяющий придать вновь создаваемой программе свойства самоконтроля. А как быть с СОМ—файлами или защитить громоздкую программу? Кроме того, существуют вирусы, которые поражают не файлы, а загрузочные секторы дисков. Для таких вирусов (их называют загрузочными) контроль PSP может оказаться неэффективным. Одним из возможных способов решения задачи является разработка специальной программы, которая проверяет первый сектор наиболее важных ЕХЕ и СОМ— файлов при каждом включении ПК. Эта же программа может проверить главный загрузочный сектор или даже все загрузочные секторы на всех дисках, чтобы убедиться в отсутствии загрузочных вирусов, а при их обнаружении удалить их.

Мною разработана программа AntiVir (прил.П9.1), реализующая описанные функции. Эта программа создает и поддерживает архив загрузочных секторов и секторов PSP. Она может работать в двух режимах — автоматическом и диалоговом.

В автоматическом режиме AntiVir проверяет текущее состояние загрузочных секторов и первых секторов для заданных файлов и сравнивает их с эталонными копиями, хранящимися в архиве. В случае обнаружения отличий программа сообщает пользователю об этом и предлагает восстановить эталонное состояние соответствующих секторов.

В диалоговом режиме программа предоставляет пользователю возможность просмотреть и скорректировать список проверяемых файлов. Диалоговая часть реализована с помощью объектно—ориентированной библиотеки Turbo Vision. Выбор нужного режима осуществляется автоматически: если программа вызывается командой ДОС

ANTIVIR она переходит к диалогу с пользователем, если командой

ANTIVIR /AUTO

реализуется режим автоматического контроля.

При контроле загрузочных секторов программа использует меры, позволяющие ей обнаруживать так называемые вирусы—невидимки. Такие вирусы контролируют обращение к функциям и прерываниям ДОС, а также к прерыванию $13 BIOS и при попытке чтения зараженного вирусом участка диска «подсовывают» программе сохраненную вирусом копию незараженного участка. Единственным способом обнаружения таких вирусов является непосредственное обращение к контроллеру диска или прямой вызов прерывания $13 в постоянной памяти BIOS. Поскольку BIOS обычно учитывает особенности конкретного контроллера диска, второй путь будет более простым, однако для его реализации необходимо каким—то образом определить начало в BIOS программы, обрабатывающей прерывание $13 (сразу после загрузки ДОС вектор $13 перехватывается программами IBMIO.COM и показывает на резидентную в оперативной памяти часть ДОС). Для определения «чистого» вектора


h0174.htm

$13 в программе используется мультиплексное прерывание $2F, которое для подфункции $13 возвращает в регистрах DS:DX требуемый адрес. Поскольку при этом прежнее содержимое регистров DS:DX автоматически помещается в вектор $13, это прерывание необходимо вызывать дважды подряд с промежуточным запоминанием регистров DS:DX в стеке (см. процедуру Bv.ild.Arch в программе ANTIVIR). В ходе контроля загрузочных секторов программа переназначает обычно пустующий вектор $62 так, чтобы он указывал на вход в обработчик $13, и использует затем этот вектор для скрытого от вируса чтения секторов жесткого диска. К сожалению этот прием нельзя использовать для контроля архивных файлов, так как в последнее время широкое распространение получили программы динамического сжатия/раскрытия информации (самыми популярными из таких программ являются Double Space и Stacker). Контроль динамически сжатых дисков непосредственным чтением секторов невозможен, так как в этом случае отключается не только возможный вирус, но и резидентная программа—деархиватор. В результате не удается найти начальный сектор защищаемого файла и проверить PSP программы.

6.5. НЕКОТОРЫЕ РЕКОМЕНДАЦИИ

1) Вставляйте имя модуля F_Anti в предложение Uses — «вакцинация» программы при ее рождении гарантирует стойкий иммунитет на весь срок ее эксплуатации.

2) Если Вы часто используете ЕХЕ— файлы, содержащие инструментальные программы (например, пс.ехе, lexicon.exe и т.п.), рекомендую поставить на них фаг Fag.prg. Кстати, если Вы устанавливаете фаг на программу, защищенную средствами модуля F_Anti, встроенный в нее контроль обнаружит инородное тело фага.

3) Все СОМ—файлы операционной программы и слишком громоздкие ЕХЕ— файлы следует защитить программой Antivir. Вызов этой программы в автоматическом режиме (с ключом /AUTO) полезно включить в файл AUTOEXEC.BAT.

4) Старайтесь как можно чаще архивировать на дискетах жизненно важные для Вас (и Вашего компьютера) файлы.


h0175.htm

Глава 7

ЗАЩИТА ПРОГРАММ ОТ НЕЛЕГАЛЬНОГО КОПИРОВАНИЯ

В главе рассматриваются проблемы создания программ, нелегальное (без ведома официального распространителя) копирование которых приводит к потере программами способности нормально работать.

7.1. СУТЬ ЗАЩИТЫ

Вряд ли во всем мире найдется хотя бы десяток программистов или людей, повседневно использующих ПК в своей профессиональной деятельности, которые с гордостью могут похвастаться тем, что никогда в жизни не использовали нелегально приобретенные программные продукты. Во всяком случае, среди отечественных программистов я таких не встречал. Сегодня сложилась парадоксальная ситуация, когда в большинстве отечественных ПК в основном используется «ворованное» программное обеспечение. Редкое исключение составляют те немногие профессионалы, которые работают в частных фирмах или на совместных предприятиях:

как правило, здесь очень дорожат репутацией фирмы и поэтому стараются использовать только лицензионные (официально купленные) программы.

Все мы понимаем, что труд автора (авторов) программы, которая пришлась нам по душе, должен быть вознагражден, но, увы! — слишком велик искус — и мы вставляем дискету в накопитель и вызываем опцию Copy программной оболочки Norton Commander (которая, кстати, тоже почти никогда не приобретается законным путем).

В соответствии с международным правом труд автора программы приравнен к труду других творцов интеллектуальной собственности, таких как писатели, музыканты, художники, и подлежит защите. Однако в отличие от книги или картины массовое копирование программы не вызывает каких-либо технических трудностей и не требует специального оборудования (если, разумеется, не считать ПК). В этом отношении программа намного беззащитнее, чем, скажем, скульптура или книга. Общий ущерб от нелегального копирования программ по оценкам западных экспертов составляет от 2 до 10 млрд. долларов в год. Вряд ли в ближайшем будущем что-либо кардинально изменится в этом отношении, особенно в нашей стране.

Вполне понятным поэтому кажется стремление авторов придать своим программам такие свойства, которые бы делали невозможным их нелегальное (помимо воли автора) распространение. В этом разделе мы обсудим технику разработки программ, в той или иной мере обладающих этими свойствами. Однако я должен сразу же оговориться, что не существует такой защиты, которую было бы невозможно — опять-таки помимо воли автора — снять. Вы должны отчетливо представлять себе, что опытный программист, обладающий соответствующими навыками, всегда


h0176.htm

сможет найти то место (те места) в Вашей программе, где принимается решение о легальности копии, и, изменив несколько байт в коде программы, лишить ее возможности к самозащите. Именно по этой причине ведущие фирмы—производители массового программного обеспечения практически никогда не ставят защиту на свои программы, справедливо полагая, что не стоит тратить силы и средства на создание систем защиты (тем более, что эти системы, как правило, причиняют пользователю определенные неудобства), если все равно программа будет «вскрыта». Эти фирмы получают свои дивиденды за счет массовости объема продаж при сравнительно низкой цене за каждую копию. Они делают ставку на «цивилизованных» покупателей и, что примечательно, таким способом воспитывают их! Более того, в последнее время получили распространение программы, которые как раз рассчитаны на механизм «пиратского» копирования и распространяются преимущественно именно таким способом:

обычно эти программы сопровождаются «электронным письмом» (файлом с текстом), в котором содержится краткая инструкция по работе с программой и указываются необходимые координаты автора с просьбой выслать небольшую сумму в случае, если пользователь считает, что дос — тоинства программы заслуживают этого.

Несколько иначе обстоит дело с программами, которые не рассчитаны на массового пользователя. К таким относятся различного рода системы автоматизированного проектирования, предыздательские системы, специализированные базы данных и т.п. Как правило, это весьма наукоемкие товары, т.е. в них особенно велик вклад высококлассных специалистов в конкретных прикладных областях. Труд таких специалистов обычно высоко ценится, поэтому общие затраты на создание подобного рода программ могут быть весьма велики, что в сочетании со сравнительно небольшим кругом потенциальных пользователей делает цену каждой копии очень большой. Такие программы обычно снабжаются защитой, так как ограниченный спрос на них формирует весьма специфичный (и чаще всего «цивилизованный») рынок: покупателями этих программ являются специалисты в конкретной прикладной деятельности, которые не имеют нужных навыков и, главное, желания заниматься «вскрытием» программ.

Будем считать программу защищенной от нелегального копирования, если в ней есть встроенные средства, позволяющие проверить саму программу и/или характерные признаки ПК, на котором она выполняется, с целью определить, была ли копия программы сделана с соблюдением всей необходимой технологии. Если технология создания копии была нарушена, программа перестает работать нормальным образом. Таким образом, легальное копирование подразумевает использование некоторой особой технологии создания копий, в необычности которой и заключается весь фокус. Лишь посвященный в этот секрет человек с помощью специального оборудования или особой программы может создать легальную копию — на это и делается ставка.

Любая копия защищенной программы должна содержать в себе или во внешнем файле «ключ» — одно или несколько кодовых чисел. В момент проверки программа сравнивает некоторые специфические признаки рабочей среды с заранее закодированными в ключе и по результатам


h0177.htm

сравнения .формирует соответствующий признак. Таким образом, мало создать копию программы: для того чтобы эта копия стала работоспособной, ей необходимо передать ключ, настроенный на работу с вполне определенным компьютером.

7.2. АНАЛИЗ ИНДИВИДУАЛЬНЫХ ПРИЗНАКОВ СРЕДЫ

Какими специфическими признаками может обладать тот компьютер, точнее та программно—аппаратная среда, в которой работает программа? Для IBM— совместимых ПК этими признаками могут быть:

• тип ПК и тип (версия) операционной системы;

• дата изготовления ПЗУ BIOS и/или его контрольная сумма;

• физическое положение файлов на дисковом носителе;

• состав аппаратных средств;

• наличие скрытых частей программы;

• физические особенности (в том числе дефекты) носителя. Некоторые из этих признаков очень индивидуальны (например, физические особенности некачественного носителя), другие обладают меньшей индивидуальностью (тип ПК, версия ДОС). Программа может использовать один или несколько признаков для проверки легальности копии. При этом особое значение приобретает способ использования программы: если программа рассчитана на работу на конкретном ПК, выбираются одни признаки, если она может свободно перемещаться с одного компьютера на другой без потери работоспособности,— другие. Назовем программы первого типа стационарными, а второго — мобильными. Защита тех и других программ имеет свои особенности, которые мы будем по мере необходимости обсуждать.

Во всех случаях проверка легальности не должна существенно сказываться на быстродействии программы или требовать от пользователя каких—то дополнительных действий. Например, вряд ли можно считать сколько-нибудь эффективной систему, использующую пароль (кодовое слово), который должен ввести пользователь: во—первых, пользователь может забыть это слово и тем самым лишиться законно приобретенной программы, а во-вторых, ничто не мешает ему сообщить это слово любому другому пользователю. Система защиты не должна проверять пользователя, она должна проверить копию! На мой взгляд, это утверждение не вызывает сомнений.

7.2.1. Проверка типа ПК и версии ДОС

Эти проверки очень просты, но не обладают высокой степенью индивидуальности в том смысле, что могут существовать многие сотни тысяч ПК одного типа, в которых используется одинаковая ДОС. Поэтому обычно эти проверки используются в сочетании с проверками других индивидуальных признаков и предназначены для защиты стационарных программ.


h0178.htm

17 а___________________________________________________Глава 7

Тип ПК записан в ПЗУ по адресу $FOOO:$FFFE, т.е. в предпоследнем байте мегабайтного адресного пространства ПК. Значениями этого байта могут быть следующие коды:

Код | Тип ПК
FF | PC
FE | XT
FD | PCjr
FC | AT

Следующая программа выводит на экран тип ПК:

begin

case Mem[$FOOO:$FFFE] of

$FF: WriteLn('PC') ;

$FE: WriteLn('XT');

$FD: WriteLn('PCjr');

$FC: WriteLn('AT');

else

WriteLnCнестандартный тип ПК ',Mem[$FOOO:$FFFE]) end end.

Версию ДОС можно получить с помощью функции ДОС $30. При обращении к этой функции в регистре AL возвращается старший, а в АН — младший номера версии. Например, если используется MS-DOS версии 3.30, то AL содержит 3, а АН — 30:

Uses DOS;

var

R: registers;

begin

with R do begin

AH := $30;

MSDOS(R) ;

WriteLn (' Версия ДОС ', AI,, ' .', АН) end end.

Регистр AL может содержать О, если используется более ранняя версия ДОС чем 2.0.

Ценность этих проверок заключается в их исключительной простоте, однако, согласитесь, что могут найтись тысячи однотипных компьютеров, на которых используется одинаковая версия ДОС, поэтому ограничиваться только этими проверками вряд ли имеет смысл.


h0179.htm

Защита программ от нелегального копирования______________________ 173

7.2.2. Проверка даты изготовления и контрольной суммы ПЗУ

Постоянное запоминающее устройство (ПЗУ) является неотъемлемой составной частью любого ИРМ—совместимого ПК. Содержимое ПЗУ учитывает особенности реализации конкретного ПК и может отличаться в компьютерах разного типа. Более того в конце ПЗУ (по адресу $FOOO:$FFF5) обычно записывается дата его изготовления, поэтому даже для ПК одного типа (и одной и той же фирмы—изготовителя) контрольная сумма ПЗУ отличается в разных экземплярах ПК.

Дата изготовления ПЗУ находится по адресу $FOOO: $FFF5 и занимает 8 смежных байт. Данные хранятся в символьном виде в формате MM/DD/YY (ММ — символы номера месяца, DD — номера дня, YY — номера года), например «06/26/92». Следующая программа выводит на экран дату изготовления ПЗУ:

var

k: Integer;

begin

for k -.^ 0 to 7 do

Write(chr(Mem[$FOOO:$FFF5+k])) ;

WriteLn end.

Как показывает практика, любая уважающая себя фирма—изготовитель ПЗУ для IBM— совместимых ПК тщательно следит за корректностью этой даты. Конечно, каждый день во всем мире изготавливаются тысячи микросхем ПЗУ с одинаковой датой, однако вероятность того, что на конкурирующей с Вами фирме используются ПК того же типа и с такой же датой изготовления, как и у Вашего компьютера, согласитесь, крайне мала. Разумеется, при массовой закупке ПК, например для оснащения учебного класса многие или даже все одновременно приобретенные компьютеры могут иметь одну и ту же дату изготовления ПЗУ. Однако в таких случаях способность защищенных программ свободно переноситься с одного родственного компьютера на другой можно рассматривать как вполне естественную.

Эта проверка используется для защиты стационарных программ.

7.2.3. Проверка места расположения файла на диске

Хорошей индивидуальностью обладает физический номер кластера, начиная с которого на жестком диске располагается файл с защищенной программой. Действительно, вряд ли что-либо другое в аппаратно— программной среде ПК (кроме, разумеется, содержимого оперативной памяти) меняется столь же динамично, как файловая структура жесткого диска. При создании легальной копии номер начального кластера для файла программы на жестком диске в общем случае совершенно случаен. Если в момент запуска программа проверит этот номер, то в подавляющем большинстве случаев она легко обнаружит факт нелегального копирования.


h0180.htm

Я сам довольно долго использовал эту характеристику для защиты одной из своих программ. Насколько мне известно, десятки попыток нелегального переноса этой программы окончились неудачей. Тем не менее такой способ защиты нельзя считать идеальным по многим причинам. Проверка номера кластера выполняется далеко не так просто, как проверка типа ПК или даты изготовления ПЗУ, поскольку в стандартном Турбо Паскале нет средств для работы с дисками на физическом уровне. Однако главный недостаток заключается в другом: любое изменение местоположения файла даже в пределах одного каталога приводит к тому, что ранее установленная копия становится нелегальной. Это крайне неудобно для пользователя, в особенности если он часто прибегает к процедуре переупорядочения файловой структуры с помощью утилиты типа программы П.Нортона Speed Disk.

Для проверки номера кластера можно использовать модуль F_Disk, описанный в гл.3. В него входит процедура GetDirItem, возвращающая элемент каталога для заданного имени файла. Параметр FirstC этого элемента содержит интересующий нас номер.

Следующая программа выведет номер кластера для «своего» файла (т.е. ЕХЕ— файлйг в котором она расположена). Для нормальной работы программы в среде Турбо Паскаль она должна компилироваться на диск.

Uses F_Disk;

var

DI: Dir_Type;

begin

GetDirItem(ParamStr(0),DI) ;

WriteLn('Файл ',ParamStr(0),

' начинается с кластера ',DI.FirstC) end.

Если Вы считаете, что номер единственного кластера не обладает необходимой степенью индивидуальности, Вы можете проверять цепочку кластеров по таблице FAT или начальные кластеры нескольких файлов.

Разумеется, такая проверка может использоваться для защиты только стационарных программ.

7.2.4. Проверка состава аппаратных средств

Программа может проверить объем доступной оперативной памяти, наличие и объем расширенной памяти, тип центрального процессора и приблизительную скорость его работы, наличие математического сопроцессора, количество и тип дисководов для гибких дисков, параметры физического жесткого диска, количество логических дисков, количество и тип каналов для подключения внешних устройств. Вот, пожалуй, и все. Каждая из этих характеристик может повторяться в тысячах других ПК, однако все они в комплексе будут достаточно индивидуальны и поэтому могут с успехом использоваться для защиты стационарных программ.

Некоторые иностранные фирмы для защиты мобильных программ выпускают так называемые электронные ключи — относительно дешевые


h0181.htm

устройства, которые перед запуском защищаемой программы подсоединяются к стандартному каналу последовательного или параллельного ввода—вывода (например, для одной из используемых мною программ этот ключ вставляется как переходник между разъемом параллельного порта и кабелем принтера). Электронные ключи реализуются на основе заказных микросхем и осуществляют нужное интерфейсное взаимодействие с защищаемой программой.

Объем доступной оперативной памяти на IBM— совместимых ПК может составлять от 64 до 640 Кбайт (речь идет о стандартной памяти, см. п.5.1). При инициации ДОС в двухбайтное слово по адресу $0000:$0413 заносится количество килобайт доступной ДОС оперативной памяти. Следует заметить, что к моменту загрузки ДОС в памяти могут устанавливаться резидентные программы (чаще всего это драйверы устройств), так что доступная остальным программам ДОС память в общем случае будет меньше физической памяти ПК. Чтобы определить объем физически установленной в ПК оперативной памяти, следует предварительно определить тип ПК. Дело в том, что для компьютеров класса IBM AT и PS/2 используется специальная энергонезависимая КМОП—память1 , хранящая некоторую весьма полезную информацию о составе аппаратных средств ПК и, в том числе, — о доступной памяти, в то время как на компьютерах IBM PC и IBM XT такой памяти нет.

Структура КМОП—памяти может быть описана следующим образом:

type

CMOS_Type = record case Byte of

1: (

Sec . Byte {Секунды системного времени}

ASec Byte {Секунды будильника}

Min Byte {Минуты системного времени}

AMin Byte {Минуты будильника}

Hour Byte {Часы системного времени}

AHour Byte {Часы будильника}

DOW Byte {День недели текущей даты}

Day ' Byte {День текущей даты}

Month Byte {Месяц}

Year Byte {Год}

StatA Byte {Состояние порта А}

StatB Byte {Состояние порта В}

StatC Byte {Состояние порта С}

StatD Byte {Состояние порта D)

POST Byte {Статус завершения программы POST

(проверка работоспособности ПК)} Shut Byte {Байт состояния программы перезагрузки ДОС}

1 КМОП — сокращение от Комплементарная пара Металл—Окисел—Полупроводник (англ. CMOS) — название технологии изготовления микросхем с пониженным энергопотреблением. Энергонезависимость КМОП—памяти достигается ее питанием от автономной батарейки или аккумулятора.


h0182.htm

{Начало массива из 17 байт, защищаемого контрольной суммой}

Diskette: Byte;{Тип накопителя ГД}

Re si Byte; {He используется}

HD Byte; {Тип накопителя ЖД}

Res2 Byte; {He используется}

Equipm Byte; {Байт оборудования}

BaseMem Word; {Объем основной памяти}

ExpnMem Word; {Объем расширенной памяти}

HD1 Byte; {Тип ЖД N1}

HD2 Byte; {Тип ЖД N2}

Res3 array [$1B..$20] of Byte; {He используется} {Конец защищаемого массива}

Res4 rray [$21..$2D] of Byte; {He используется}

Checks Word; {Контрольная сумма}

ExtendM Word; {Дополнительная память}

Century Byte; /Текущее столетие}

Miscell Byte; {Разная информация}

Res5 array [$34..$3F] of Byte) ;

2:(CMOS array [$0..$3F] of Byte) end;

Первые 10 байт этой структуры предназначены мя обслуживания системных часов. Информация в этих байтах хранится в так называемом двоично—десятичном формате (старший полубайт хранит десятки, а младший — единицы). Поскольку КМ ОП—память обычно питается от подзаряжаемого аккумулятора, системные часы работают даже после отключения ПК от сети и способны сохранять правильную дату практически неограниченно долго, если Вы регулярно включаете ПК/

Заметим, что поля ASec, AMin и AHour определяют момент времени инициации аппаратного прерывания IRQ8, с помощью которого можно автоматически запустить какую-либо программу реального времени (т.е. программу, которая должна исполняться в строго определенный момент реального времени).

Семнадцать байт, начиная с поля Diskette, защищены контрольной суммой, хранящейся «задом наперед» в поле Checks: младший байт содержит старшие разряды суммы, в то время как в соответствии со стандартом IBM в младшем байте должны храниться младшие биты слова. Проверка контрольной суммы осуществляется в ходе выполнения программы POST (программы контроля работоспособности ПК) при каждом включении компьютера и служит для оценки степени разряженности батарейки автономного питания КМОП — памяти.

Поле BaseMem хранит суммарный объем (в килобайтах) оперативной памяти ПК, а поля ExtdMem и ExtendM — объем дополнительной памяти.

Доступ к содержимому КМОП—памяти возможен только как к внешнему устройству, подключенному к портам $70 и $71: сначала в порт $70 следует поместить номер нужного байта (нумерация начинается с нуля), а затем прочитать значение этого байта из порта $71. КМОП—память отличается сравнительно большим временем доступа, поэтому между двумя


h0183.htm

последовательными обращениями к портам полезно сделать небольшую паузу.

Объем установленной оперативной памяти можно определить с помощью приведенной ниже несложной программы, осуществляющей анализ КМОП—памяти для ПК типа AT или непосредственное тестирование микросхем ОЗУ (для PS/XT). При тестировании учитывается то обстоятельство, что память ПК наращивается так называемыми банками памяти по 64 Кбайт, причем чтение из любого байта несуществующего банка возвращает код 233. Таким образом, достаточно убедиться в наличии одного байта из каждых 64 Кбайт:

{+_-_--_---------------------—-----,»-----+

¦ Эта программа определяет количество ¦ ¦ оперативной памяти, установленной в ПК ¦ +——————————————————————————+/

var

b : Byte;

k,j,m,e: Word;

begin {Проверяем тип ПК}

if Mem[$FOOO:$FFFE]='$FC then {Компьютер типа IBM AT - читаем КМОП-память/ begin

Port[$70] := $15;

m := Port[$71]; {Основная память} Port[$70] := $16;

m := m+Port[$71] shi 8;

Port[$70] := $17;

e := Port[$71j; {Дополнительная память} Port[$70] := $18;

e := e+Port[$71] shi 8 end else

begin {Компьютер типа IBM PC/XT} e :=• 0; {Нет дополнительной памяти} m := 1; {Всегда есть 64 Кбайт стандартной памяти} for k := 1 to 9 do begin

j := k shi 12; {Номер очередного сегмента) if Mem[j:0]<>233 then

inc (ra) else

begin {Проверяем код 233} Mem [j:0] : = 0 ;

if Mem[j:0]=0 then begin inc (m) ;

Mem[j:0] := 233


h0184.htm

end end end;

m := m*64 end;

WriteLn('B ПК установлено ',m,' КБайт основной памяти');

if е<>0 then

WriteLn(' и ',е, ' Кбайт дополнительной') end.

Информация о других устройствах, входящих в состав ПК, может быть получена на основании анализа так называемого регистра оборудования. Этот регистр для машин класса IBM XT формируется программами ПЗУ при загрузке ДОС и располагается в двухбайтном слове по адресу $0000:$0410. Его разряды имеют следующий смысл:

Разряд | Значение | Смысл
о | i | В ПК имеются накопители ГД
i | i | Есть арифметический сопроцессор
2-3 | 3 | Бсть стандартная память 64 Кбайт
4-5 |  | Тип активного видеоадаптера:
 | 0 | Адаптер EGA или VGA
 | 1 | Цветной адаптер 40х25
 | 2 | Цветной адаптер 80х25
 | 3 | Монохромный адаптер
6-7 |  | Число НГД (если бит 0 имеет значение 1)
8 |  | Не используется
9-11 |  | Количество адаптеров связных каналов
12 | 1 | Есть игровой порт
13 |  | Не используется
14-15 |  | Количество принтеров

Для IBM AT информацию о переферийных устройствах содержит поле Equipm в КМОП—памяти. Назначение разрядов этого байта аналогично назначению разрядов О...7 регистра оборудования, за исключением разрядов 2...3, которые не используются. Количество связных каналов последовательного типа для компьютеров этого класса можно получить путем анализа области памяти BIOS: начиная с адреса $0000:$0400 в памяти располагаются четыре двухбайтных слова, содержащие адреса последовательных портов; порту СОМ1 соответствует адрес в слове $0000:$0400, а COM4 — в слове $0000:$0406; нулевое содержимое этих слов говорит об отсутствии соответствующего канала связи. Точно так же можно анализировать адреса параллельных портов ($0000:$0408,...,$0000:$040Е).

Следующая программа сообщает оСъс;! памяти, указываемый в слове $0000:$0413, и расшифровывает рс.истр (G^h) оборудования и область адресов каналов связи (для AT):

^—————————————————————————+

¦ Программа анализирует байт оборудования \ ¦ и выводит на экран его расшифровку I


h0185.htm

+——————————————+;

var

a,b: Word;

begin

{Сообщаем объем оперативной памяти}

WriteLn(MemW[0:$413],' Кбайт оперативной памяти');

{Определяем тип ПК}

if Mem[$FOOO:$FFFE] = $FC then begin {Тип AT}

WriteLn('Компьютер типа IBM AT содержит:');

Port[$70] := $14;

a := Port[$71] ;

if a and K>0 then case (a shr 6) and 3 of

0: WriteLn('- один накопитель ГМД');

1: WriteLn('- два накопителя ГМД');

end;

if a and 2 о 0 then

WriteLn('- арифметический сопроцессор');

case (a shr 4) and 3 of

0: WriteLn('- адаптер EGA или VGA');

1: WriteLn('- цветной адаптер 40х25');

2: WriteLn('- цветной адаптер 80х25');

3: WriteLn('- монохромный дисплей') end;

{Анализируем количество последовательных портов} а := 0;

for b := 0 to 3 do

if MemW[O:$4OO+b shi 2]<>0 then inc (a) ;

WriteLn('- ',a,' последовательных порта');

{Анализируем количество параллельных портов) а := 0;

for b := 0 to 3 do

if MemW[O:$408+b shi 2]<>0 then inc (a) ;

WriteLn('- '/а,' параллельных порта') end else

begin {Тип XT}

WriteLn('Компьютер типа IBM XT содержит:');

a := MemW[0:$ 410];

if a and 1<>0 then

WriteLn('- ',(a shr 6) and 3,' накопителей ГМД');

if a and 2<>0 then

WriteLn('- арифметический сопроцессор');

if a and 12<>0 then


h0186.htm

WriteLn('- базовую память 64К');

case (a shr 4) and 3 of

0: WriteLn('- адаптер типа EGA или VGA');

1: WriteLn('- цветной адаптер 40х25');

2: WriteLnC- цветной адаптер 80х25');

3: WriteLn('- монохромный адаптер') end;

WriteLnf'- ',(a shr 9) and 7,' каналов связи');

if (a shr 12) and lo0 then

WriteLn('- игровой порт');

WriteLn('- ',(a shr 14),' принтеров') end end.

Производительность микропроцессора обычно измеряется с помощью многократного прогона тестового участка программы за заданный интервал времени. Количество прогонов и является мерой производительности ПК. Для определения нужного интервала времени удобнее всего использовать переменную типа Longint по адресу $0000:$046С, в которой ДОС хранит текущее системное время в виде количества 55 — миллисекундных интервалов, прошедших от 0 часов.

Следующая программа оценивает производительность процессора и выводит на экран среднее количество прогонов тестового участка программы за один 55 — миллисекундный интервал:

{ Определение производительности ПК ] const

N = 10; {Количество повторов} var

Time: Longint; {Моменты времени} k : Longint; {Счетчик вычислений} j : Integer; {Счетчик повторов} begin k := 0;

for j := 1 to N do begin

Time := MemL[0:$O46C]; {Начальное время} while MemL[O:$O46C]=Time do

; {Ждать, пока не изменится время} inc(Time,2); {Конечное время} while MemL[O:$O46C]OTime do

inc(k); {Цикл вычислений} end;

WriteLn(k div N) end.

В этой программе цикл

while MemL[0:$046C]«Time do;


h0187.htm

введен для синхронизации начала вычислений с началом очередного 55 — миллисекундного интервала. Как показывает практика, получаемая такой программой оценка производительности очень индивидуальна. Мне, например, не удалось найти среди 8 однотипных компьютеров ни одной пары с одинаковой числовой мерой производительности. Следует, правда, оговориться, что на двух ПК эта мера менялась от одного прогона программы к другому приблизительно на 0.5%, что, судя по всему, является следствием нестабильности работы тактовых генераторов. В связи с этим при разработке коммерческой системы защиты на основе измерения производительности ПК необходимо вводить некоторый доверительный интервал, связанный с нестабильностью работы тактовых генераторов, а это — увы! — существенно уменьшает степень индивидуальности оценки.

7.2.5. Использование скрытых частей программы и особенностей физических носителей информации

Достаточно эффективным способом защиты (главным образом для мобильных программ) может служить создание и использование скрытых частей программы и/или особенностей физических носителей информации.

Скрытые части программы — это участки дискового носителя, тем или иным способом связанные с программой, но не зафиксированные в качестве файлов ДОС. В подавляющем большинстве случаев программе нет необходимости искусственно создавать такие участки, поскольку они уже имеются в «хвосте» любого файла. Дело в том, что ДОС распределяет дисковое пространство кластерами, имеющими длину от 512 до 4096 и более байтов. Даже если полезная длина файла составляет всего несколько байт, ДОС выделяет такому файлу целый кластер, большая часть которого будет заполнена «мусором» — случайной информацией, сохранившейся от предыдущего использования кластера в составе другого файла. При копировании файлов стандартными средствами ДОС копируется только полезная часть кластера, так что на новом месте «хвост» файла в общем случае будет заполнен другой информацией.

Следующий простой пример иллюстрирует использование скрытой части файла для защиты программы от нелегального копирования. В этом примере программа управляется с помощью параметра запуска «/S»: если команда запуска программы дополнена этими символами, программа вводит с клавиатуры произвольную строку и помещает ее в «хвост» файла, в противном случае читает строку с диска и выводит ее на экран.

_•+——————————.——————————————————+

I Программа создает и контролирует скрытую \ ¦ часть файла. При запуске без ключа /S \ '. осуществляется контроль файла, при запуске ¦ i с ключом - создание скрытой части. ¦ +—————————.———,————————————————+/

var

F: File; {Файловая переменная для файла программы}


h0188.htm

S: String; {Переменная для создания скрытой части} L: Longint; 'Полезная длина файла} begin

Assign(F,ParamStr(0)) ;

'Reset(P,1) ;

L := FileSize(F) ;

WriteLn('Гарантированный остаток: ', mod 512,' байт');

Seek(F,L); {Указатель - в конец файла} if ParamStr(1)='/S' then

begin {Создаем скрытую часть} WriteLn('Введите произвольную текстовую строку');

ReadLn(S);

BlockWrite(F,S,succ (Length(S))) ;

Seek(F,L); {Восстанавливаем...} Truncate(F) {...прежнюю длину файла} end else

begin {Проверяем скрытую часть} Seek(F,L+256); {Увеличиваем длину файла} BlockWrite(F,S,1); {на 256 байт, чтобы исключить

ошибку чтения из "хвоста" файла} Seek(F,L) ;

BlockRead(F,S,256) ;

WriteLn('Скрытая часть файла:');

WriteLn (S) ;

Seek(F,L); {Восстанавливаем} Truncate(F) {прежнюю длину файла} end;

Close(P) end.

Более изощренный, но ничуть не более эффективный способ защиты состоит в создании и использовании дополнительных скрытых кластеров. Такие кластеры могут помечаться в FAT как сбойные или «потерянные» (т.е. не относящиеся ни к какому зарегистрированному файлу). Во всех случаях, помещается ли ключ в хвост файла или в отдельный кластер, защита может быть легко нейтрализована, если используется копирование дискеты «блок в блок» с помощью системной утилиты DISKCOPY или аналогичных несистемных программ.

Существенно лучшей способностью противостоять попыткам нелегального копирования обладает система защиты, основанная на учете индивидуальных особенностей дискет, прежде всего на анализе неустранимых дефектов. В этом случае система проверки защиты «знает» список дефектных секторов оригинальной дискеты и пытается их отформатировать. Если после форматирования обмен информацией с сектором проходит нормально, значит соответствующий сектор — бездефектный и, следовательно, мы имеем дело с нелегальной копией дискеты. Главное достоинство этого способа защиты заключается в принципиальной


h0189.htm

Невозможности создать программными средствами на нормальной дискете неустранимые дефекты.

Как показывает практика, лишь очень небольшое число дискет (менее 1%) имеет заводские дефекты изготовления, поэтому при массовом тиражировании коммерческих программ приходится создавать такие дефекты искусственно. Для этого иногда используются лазеры, а чаще — обыкновенная булавка. После некоторой тренировки Вы всегда сможете наносить царапины на слой носителя или даже прокалывать дискету так, чтобы по возможности сохранить работоспособность большей ее части. Однако следует иметь в виду, что царапины и проколы на поверхности дискеты могут повредить считывающие головки накопителя.

Следующая программа выводит на экран номера всех секторов дискеты, имеющих неустранимые дефекты. Программа сначала определяет истинное количество дорожек Trk и секторов NS на дорожке дискеты (в привод дисковода, рассчитанного на дискеты 1.2 Мбайт, может быть вставлена дискета емкостью 360 Кбайт). Проверка этих параметров осуществляется непосредственно по блоку параметров BIOS (BPB], считываемому из загрузочного сектора дискеты. После этого соответствующим образом изменяется таблица параметров дискеты (ТПД) и осуществляется цикл чтения по всем Trk дорожкам. Если в ходе чтения возникла ошибка, про — грамма приступает к детальному анализу дорожки. Она вначале пытается прочитать и запомнить информацию, содержащуюся в каждом из ее N5 секторов на обеих поверхностях, затем форматирует дорожку и восстанавливает прежнее содержимое секторов. Если после такой операции на дорожке останутся сбойные секторы, программа выводит на экран их

номера. {+—— ————------—-------——----------——--+

¦ Программа считывает информацию с дискеты по

I дорожкам. При обнаружении сбойной дорожки

¦ определяется сбойный сектор, информация из

I остальных секторов запоминается, а дорожка

' форматируется заново, после чего восстана-

', вливается содержимое несбойных секторов.

I Если при повторной проверке вновь возникла

ч ошибка, печатается фраза

¦ "Дефектный сектор NNN".

+---------------------------------------------т/

Uses DOS, F_Disk;

type

PDBT_Type ^DBT^Type; {Указатель на ТПД} {Таблица параметров дискеты} DBT_Type = record

Reservl array [0..2] of Byte;

SizeCode Byte; {Код размера сектора}

LastSect Byte; {Количество секторова дорожке}

Reserv2 array [5..7] of Byte;

FillChar Char; {Символ-заполнитель для форматирования}


h0190.htm

Reserv3 : Word end;

{Элемент буфера форматирования} F_Buf = record

Track: Byte; {Номер дорожки} Head : Byte; {Номер головки} Sect : Byte; {Номер сектора} Size : Byte {Код размера} end;

TrackType = array [O..MaxInt] of Byte;

const

DSK = 0; {Номер диска} var

Info: TDisk; {Информация о диске} Old: PDBT_Type; {Указатель на исходную ТПД} DBT: PDBT_Type; {Указатель на новую ТПД} TRK: Word; {Количество дорожек} NS : Word; {Количество секторов на дорожке} i, {Счетчик поверхностей} j, /Счетчик секторов} k, {Счетчик дорожек} nn: Integer; {Номер сектора в цилиндре} Р:"TrackType; {Буфер чтения/записи} R: registers; {Регистры ЦП} BF : array [0..20] of F_Buf; {Буфер для форматирования} begin

{Определяем количество дорожек, головок и количество секторов на дорожке} GetDiskInfo(DSK,Info) ;

if Disk_Error then begin

WriteLn('Ошибка доступа к диску');

Halt end;

Trk := Info.Tracks;

NS := Info.TrackSiz;

{Резервируем память для буфера} GetMem(P,2*NS*512) ;

(Готовим нужную ТПД}

Old := ptr(MemW[0:$lE*4+2],MemW[0:$1Е*4]);

New(DBT) ;

DBT^:= Old"; {Получаем копию ТПД в ОЗУ} SetIntVec($1E,DBT); {Изменяем ссылку на ТПД} DBT^ .Last-Sect := NS; {Устанавливаем нужное

количество секторов на дорожке} {Цикл проверки дорожек}

for k := 0 to TRK-1 do with R do begin


h0191.htm

ah := 2; {Код операции чтения}

al := 2*NS; {Количество секторов чтения}

ch := k; {Номер дорожки}

с1 := 1; {Начать с 1-го сектора)

dh := 0; {Начать с 0-й поверхности}

dl := DSK; {Номер диска}

es := seg(pл) ;

bx := ofs (p") ;

Intr($13,R); {Читаем всю дорожку} if (Flags and FCarry)<>0 then

begin {Обнаружена сбойная дорожка} {Читаем дорожку по секторам}

for i := 0 to I do {2 поверхности} for j := 1 to MS do begin

ah := 2; {Код операции чтения}

al := 1; {Читаем один сектор}

ch := k; {Номер дорожки}

с1 := j; {Номер сектора}

dh := i; {Номер головки}

dl := DSK; {Номер диска}

nn := i*NS+pred(j) ;

es := seg{p^[nn*512}) ;

bx := seg(P/\[nn*512]) ;

Intr($13,R) {Читаем сектор} end;

{Форматируем дорожку} for i := 0 to 1 do

begin {Цикл по головкам} for j := 1 to NS do with BF[j] do begin {Готовим буфер} Track:= k;

Sect :° j;

Head := i;

Size := OlcT.SizeCode end;

ah =5; {Операция форматирования} al = NS; {Количество секторов на дорожке} ch == k; {Номер дорожки} с1 =1; {Начать с 1-го сектора} dh = i; {Номер головки} dl = DSK; {Номер диска} es = seg(BF) ;

bx = ofs(BF) ;

Intr($13,R); {Форматируем поверхность} end;

{Восстанавливаем содержимое дорожки и заново проверяем секторы}


h0192.htm

192 Глава 7

for i := 0 to 1 do {2 поверхности} for j := 1 to NS do begin

{Восстанавливаем содержимое сектора} ah : = 3; {Код операции записи} а1 := 1; {Записываем 1 сектор} ch := k; {Номер дорожки] • с1 := j; {Номер сектора} dh := i; {Номер головки} dl := DSK; {Номер диска} пп := i*NS+pred(j) ;

es := seg(PA[nn*512]) ;

bx := ofs(P"[nn*512]);

Intr($13,R) ;

{Читаем сектор)

ah := 2; /й'од операции чтения}

а1 := 1; {Читаем 1 сектор}

ch := k; {Номер дорожки}

с1 :== j; {Номер сектора}

dh :== i; {Номер головки}

dl := DSK; {Номер диска}

es := seg{P^[nr\*512] ) ;

bx := ofstP^nr^S:!^]) ;

Intr($13,R) ;

if (Flags and FCarry)<>0 then

WriteLn('Дефектный сектор ',(k*2+i)*NS+j) end end end;

SetIntVec($lE,01d) {Восстанавливаем прежнюю ТПД} end.

Недостатком описанного способа защиты являются относительно большие затраты времени на контроль всей дискеты и потеря работоспособности некоторой ее части. От этих недостатков можно избавиться, если на дискете создать программным способом нестандартные для ДОС особенности. Этими особенностями могут быть:

• нестандартная длина секторов на всей дискете или какой-либо одной ее дорожке;

• специальное расположение (фактор чередования) секторов на дорожке;

• нестандартное количество дорожек.

Разумеется, надежность защиты с помощью программно создаваемых особенностей структуры дискеты будет значительно меньше. Тем не менее следует помнить, что в большинстве случаев «взломщик» программы стремится изменить ее код, а не имитировать особый способ копирования дискет, так что несложная защита, связанная с использованием допол—


h0193.htm

нительной дорожки, может оказаться ничуть не хуже, чем защита с помощью «лазерной дырки».

Как известно, ДОС может оперировать только с секторами длиной по 512 байт (исключением является создание утилитой VDISK виртуальных электронных дисков, размер секторов которых может отличаться от 512 байт). В то же время контроллеры ГД способны создавать и использовать секторы другого размера — по 128, 256 или 1024 байт. При обнаружении сектора нестандартного размера ДОС считает этот сектор сбойным, что можно использовать для защиты программы.

Далее, дорожки на диске располагаются так, что самой внешней является нулевая дорожка, а самой внутренней — дорожка с максимальным номером. Обычно ДОС использует одинаковое количество секторов на всех дорожках, поэтому угловой размер каждого сектора постоянен, а следовательно, плотность записи информации растет с ростом номера дорожки. Количество секторов на дорожке и дорожек на дискете ДОС назначает так, чтобы даже для самой внутренней дорожки эта плотность не превысила некоторого значения, еще гарантирующего уверенную работу схем контроллера ГД. На практике оказывается, что подавляющее большинство современных контроллеров способно обслуживать большее количество дорожек, чем принято в ДОС. В целях защиты от копирования программа может создать и использовать одну или несколько дополнительных дорожек, но не вносить их в список «видимых для ДОС», т.е. не изменять поле BPB.TotSecs в загрузочном секторе, указывающее общее количество секторов на диске. Разумеется, возможен и другой вариант:

можно «украсть» у ДОС несколько дорожек, уменьшив стандартное значение этого поля, однако нестандартная емкость дискеты легко обнаруживается, что снижает эффективность защиты. Заметим, что дополнительные дорожки могут отделяться от основной рабочей зоны дискеты неотформатированным интервалом, что может затруднить их обнаружение специальными программами копирования.

Наконец, программа может использовать нестандартный фактор чередования секторов. Напомню (см. гл.3), что этот фактор влияет на время чтения/записи группы смежных секторов. Если какую-либо дорожку отформатировать с намеренно неоптимальным фактором чередования, время чтения этой дорожки может оказаться заметно больше, чем при чтении любой другой дорожки — вот Вам и еще один способ защиты!

В приводимой в прил.ПЮ.1 программе Diskette иллюстрируется использование всех трех перечисленных параметров. На дискете емкостью 360 Кбайт создается 41—я дорожка с девятью секторами размером по 256 байт, причем для нее используется обратный фактор чередования, т.е. секторы на дорожке размещаются в последовательности 9,8,...,2,1. После этого в первый сектор новой дорожки записывается произвольная информация, затем сектор читается и проверяется правильность операций записи—чтения. В конце программы измеряется время доступа к новой дорожке и стандартной дорожке.

1 Л 1 А &


h0194.htm

194___________________________________________________Глава 7

7.3. ЗАЩИТА ПРОГРАММ ОТ ТРАССИРОВКИ

Анализ индивидуальных признаков программно—аппаратной среды, в которой работает программа, дает ей возможность проверить легальность копии и принять решение о характере дальнейшей работы. Вот тут—то и кроется наиболее уязвимое место любой системы защиты. Действительно, сама задача защиты программ по сути своей дихотомична, т.е. предполагает выбор одного из двух возможных вариантов: либо копия легальна, либо нет. Выбор либо—либо в конечном счете реализуется машинной инструкцией условного перехода: перейти, если больше (меньше, равно и т.п.). Если в коде программы заменить эту инструкцию на команду безусловного перехода, программа всегда будет работать так, как если бы проверка легальности копии дала положительный результат. Таким образом, каким бы хитроумным не был алгоритм проверки, он легко нейтрализуется, если в точках дихотомического ветвления программы заменить инструкции условного перехода на команды безусловного перехода.

Если Вы хотите защитить свою программу от нелегального копирования, Вы должны составить ее таким образом, чтобы всемерно усложнить работу нескромному наблюдателю, пытающемуся проследить логику ее работы и отыскать ключевые точки ветвления. Фактически это означает вести борьбу с человеком, осуществляющим дизассемблирование программы (т.е. перевод машинных кодов в инструкции ассемблера) и ее трассировку (прослеживание логики работы). В теоретическом плане такую борьбу можно считать проигранной — ведь в конечном счете человек всегда умнее машины. Однако здесь уместна, как мне кажется, параллель с шахматами: известно, что теоретическое положение «белые начинают и выигрывают» вовсе не означает абсолютной бесперспективности черных! Точно также имеет шансы устоять от попыток «взлома» и грамотно составленная система защиты. Суть борьбы со «взломщиком» заключается в том, что многочисленные программные «ловушки», блокирующие работу программ—трассировщиков, и крайне запутанная логика работы системы защиты могут сделать ее «взлом» весьма трудным делом даже для опытного взломщика.

Для дизассемблирования программ обычно используются различные программы— дизассемблеры, преобразующие машинные коды в текстовые строки ассемблерных инструкций. Чтобы затруднить дизассемблирование, можно зашифровать часть программы. В этом случае в работающей про — грамме осуществляется необходимая дешифровка этих фрагментов перед тем, как им будет передано управление, а после дизассемблирования исходного ЕХЕ— файла ключевые фрагменты программы оказываются совершенно бессмысленными. Реализация этой идеи на Турбо Паскале не так проста, как это может показаться на первый взгляд. Дело в том, что компилятор Турбо Паскаля создает ЕХЕ—фэ&л, содержащий многочисленные адресные ссылки с использованием относительной адресации. В процессе загрузки файла в оперативную память осуществляется замена относительных адресов на абсолютные. Шифровка может нарушить относительную адресацию и дешифрованная программа потеряет свою работоспособность. Выходом из положения может служить разработка на


h0195.htm

Защита программ от нелегального копирования 195

ассемблере зашифрованных СОМ— программ, вызываемых из основной программы и обменивающихся с нею данными через общее поле памяти. Ссылку на это поле можно поместить в заранее обусловленный и неиспользуемый ДОС вектор прерывания. Замечу, что более или менее сложная Турбо Паскалевая программа насчитывает многие десятки, а часто и сотни килобайт и после дизассемблирования дает гигантские листинги, объемом во многие сотни тысяч и даже миллионы символов. Разобраться в этой мешанине кодов без пошаговой трассировки практически невозможно, а следовательно, можно не тратить силы на шифровку громоздких программ.

Защита от трассировки заключается в том, что программа распознает факт пошаговой трассировки и пытается тем или иным способом противодействовать этому процессу. Чаще всего для этих целей используется остроумный прием, основанный на особенностях архитектуры микропроцессоров семейства Intel 80х86. Для повышения производительности этих кристаллов в них применяется конвейерный способ обработки команд, в соответствии с которым очередная инструкция загружается во внутреннюю очередь команд процессора до завершения обработки текущей инструкции. Если текущая инструкция изменяет следующую за ней командуг то при реальной работе программы это изменение не сказывается на алгоритме, так как к этому моменту содержимое изменяемой ячейки памяти уже загружено в очередь команд. Если же программа работает под управлением трассировщика, внутренняя очередь оказывается заполненной командами трассировщика и модификация ячейки приводит к изменению алгоритма работы.

Следующая программа иллюстрирует описанный прием. В ассемблерной процедуре TrassBlock модифицируется однобайтная команда RET выхода из процедуры на команду NOP (пустая команда). Если программа управляется трассировщиком, произойдет реальная замена команды и вступит в действие остальная часть процедуры, которая реализует «горячую» перезагрузку ДОС (используется недокументированное соглашение о том, что точка входа в BIOS— программу перезапуска имеет адрес $FOOO:$FFFO;

фирмы—изготовители BIOS не обязаны следовать этому правилу). Чтобы убедиться в этом, запустите программу под управлением какого-либо отладчика, например, Turbo Debugger, и проследите ее по шагам после вызова CALL 0000 — это и есть вызов процедуры TrassBlock. Более простой способ — пошаговое прослеживание программы в среде Турбо Паскаль с помощью клавиши F7, однако в этом случае будет нарушена «чистота эксперимента» — ведь у взломщика нет исходного текста программы.

^-———————————————————————+

I Иллюстрация использования процедуры \ ] блокировки режима пошаговой \ ¦ трассировки программы I -г———————.——-————— ———————+/

Procedure TrassBlock; Assembler;

{Процедура реализует вызов программы перезапуска ДОС


h0196.htm

в случае, если она работает под управлением трассировщика} ASM

{Модификация команды по метке @}

mov BYTE PTR @,90h {Команда NOP}

{Следующая команда не модифицируется,ели нет трассировки, в противном случае она заменяется командой NOP} @: ret

{Сюда управление передается только в том случае, когда работа программы прослеживается трассировщиком} mov ax,$FOOO {Сегмент точки перезапуска} push ax

mov ax,$FFFO {Смещение точки перезапуска} push ax

retf {Перезапуск ДОС} end; {TrassBlock} begin

TrassBlock end.

Как еще программа может определить факт трассировки? Пожалуйста:

• с помощью контроля отладочных прерываний INT 1 и INT 3;

• с помощью замера времени выполнения некоторого эталонного участка программы;

• с помощью перехвата прерывания от клавиатуры;

• с помощью перехвата прерывания от таймера.

В архитектуре микропроцессора предусмотрены два отладочных прерывания с векторами 1 и 3. Первое активизируется после выполнения каждой очередной инструкции программы, если взведен флаг трассировки TF. Второе вызывается однобайтной командой INT и реализует останов в контрольной точке. Сразу после загрузки ДОС эти векторы указывают на расположенные в ПЗУ программы обработки прерываний, которые ничего не делают и просто возвращают управление прерванной программе. Таким образом, если сегментная часть этих векторов указывает на ОЗУ (меньше $АООО), есть большая вероятность того, что программа прослеживается (может оказатьсяг что векторы изменены какой—то ранее запускавшейся программой, но не восстановлены после ее завершения). Чтобы убедиться в этом, программа может проанализировать флаг TF режима трассировки и/ или попытаться заменить эти векторы так, чтобы они указывали на соОственную процедуру обработки.

Например, следующая программа использует небольшой фрагмент, написанный на встроенном ассемблере, чтобы проанализировать флаг трассировки. В результате анализа на экран выводится сообщение «Нет трассировки» или «Есть трассировка». Замечу, что некоторые отладчики, в том числе — встроенный отладчик Турбо Паскаля и мой любимый Turbo Debugger, не используют аппаратной трассировки по прерыванию INT 1 и, следовательно, программа, работающая под их управлением, не обнаруживает факт трассировки. Чтобы это все-таки произошло, трассируйте программу стандартным отладчиком Debug.


h0197.htm

^—————————_-__-____-__———+

I Программа проверяет флаг трассировки ¦

I TF и выводит соответствующее сообщение \ +——.——————————________————————+;

Uses DOS;

var

Flags: Word; {Состояние флагов МП} begin

Flags := 0;

asm

pushf {Помещаем флаги в стек} pop ax {Извлекаем их в АХ} mov Flags,ax {Пересылаем в FLAGS}

end;

if (Flags and $100)=0 then WriteLn('Нет трассировки')

else

WriteLn('Есть трассировка') end.

Замер времени выполнения эталонного участка программы во многих случаях оказывается более эффективным средством обнаружения трассировки. Для получения отсчетов времени удобно использовать уже упоминавшийся системный счетчик $0000:$046С. Например:

^————————————————————————+

¦ Контроль трассировки с помощью замера \ ¦ времени выполнения участка программы \ +—————.——————————————————————+;

var

tl,t2: Longint;

begin

t2 := 0; {Сбрасываем счетчик}

tl := MemL[0:$046С]; {Получаем начальный момент времени}

while MemL[0:$046C]=tl do; {Ждем начала очередного

55-мс интервала} {Цикл измерения} while MemL[0:$046C]<tl+2 do inc(t2) ;

{Анализируем результат} if t2<500 then

WriteLn('Есть трассировка') else

WriteLn (t2) end.

Проверка

if t2<500 then


h0198.htm

учитывает минимальную производительность компьютера класса IBM PC с тактовой частотой 4.77 МГц (около 780 единиц для этой программы).

Перехват прерывания от клавиатуры использует тот очевидный факт, что для управления трассировщиком взломщик должен использовать клавиатуру. Для обнаружения этого программа переназначает вектор прерывания $09 от клавиатуры на собственную процедуру, после чего выполняет достаточно длинный цикл. Если в ходе выполнения цикла будет нажата любая клавиша, управление получит новый обработчик прерывания $09 и таким образом программа сможет обнаружить факт трассировки.

В следующем примере процедура обработки прерывания $09 осуществляет «горячую» перезагрузку ДОС:

_•+—— —————__— —__-——____—____—+

¦ Блокировка трассирования программы ¦ ¦ с помощью контроля прерывания от ] ¦ клавиатуры \ +————.————.————————————————+_

Oses DOS;

var

01dlnt9: pointed-Procedure Int9; Assembler;

{Получает управления после нажатия на любую клавишу и перезагружает ДОС} ASM

mov ax, $FOOO

push ax

mov ax, $FFFO

push ax

retf end;

var

k,n: Longint;

begin

SwapVectors;

GetIntVec($9,01dlnt9) ;

SetIntVec($9,@Int9) ;

for k := 1 to 20000 do inc (n) ;

SetIntVec($9,01dlnt9) ;

WriteLn('HeT трассировки') end.

Приблизительно таким же способом можно использовать прерывание от таймера $16. Перед заменой векторов программа должна запретить прерывания командой CL1, затем выполнить цикл. Если программа не трассируется, управление процедуре обработки прерывания не будет передано ни разу. Напротив, трассировщик обязательно откроет прерывания и тем самым обнаружит себя.


h0199.htm

Защита программ от нелегального копирования 199

7.4. МОДУЛЬ F_Prot ДЛЯ ЗАЩИТЫ ПРОГРАММ

В заключение рассмотрим программный модуль F_Prot, реализующий некоторые из описанных мер борьбы с нелегальным копированием (прил.ПЮ.2). Разумеется, было бы неразумно в книге, рассчитанной на массового читателя, излагать все подробности сложной системы защиты. Средства, используемые в модуле, вызовут улыбку у профессионалов, тем не менее они достаточны, чтобы отпугнуть многих любителей легкой наживы.

7.4.1. Описание модуля

Модуль рассчитан на защиту как мобильных, так и стационарных программ. Основной процедурой модуля является процедура ProtCheck, осуществляющая контроль копии. Легальность мобильного варианта программы устанавливается за счет контроля скрытого сектора на ключевой дискете, в случае стационарного варианта проверяется дата создания ПЗУ. Две другие подпрограммы модуля позволяют установить защиту файла на жестком диске (подпрограмма SetOnHD) и снять защиту со стационарного варианта программы (подпрограмма RemoveFromHD).

Поскольку до сих пор мы почти не касались разницы в способах защиты мобильного и стационарного вариантов программы, имеет смысл рассмотреть эту проблему более подробно. Как уже говорилось, стационарная программа учитывает индивидуальные характеристики компьютера и может исполняться только на одном конкретном ПК. Защита таких программ обычно не вызывает серьезных проблем, во всяком случае для этого программист может использовать очень большой набор индивидуальных признаков (см. n.7.2J. Наоборот, мобильная программа не может связываться с конкретным ПК и должна учитывать какие—то привносимые признаки, т.е. признаки, которые относительно просто создать на любом ПК на время работы программы. Здесь выбор признаков намного беднее: чаще всего для этих целей используются дополнительные аппаратные устройства (ключевая дискета или аппаратный ключ), которые придаются каждой легальной копии и без которых программа не может работать нормальным образом. Если отбросить достаточно экзотичный для отечественного рынка способ защиты с помощью аппаратного ключа, в распоряжении программиста остается единственный вариант защиты мобильной программы — с помощью эталонной (ключевой) дискеты. Именно этот вариант и реализуется в модуле F_Prot.

Для создания легальной копии программы должна использоваться особая технология подготовки дискеты. Эта особенность в данном случае заключается в том, что на стандартной дискете диаметром 5'/4 дюймов, рассчитанной на емкость 360 Кбайт, создается дополнительная дорожка из нестандартных 256—байтных секторов. Один из секторов этой дорожки используется для записи ключевой информации. В процессе проверки легальности копии программы процедура ProtCheck считывает этот сектор и контролирует его содержимое. Для создания ключа можно использовать программу Diskette, описанную в п.7.2,5.


h0200.htm

Можно утверждать, что практически в любом случае коммерческого распространения программы необходимо защитить прежде всего ее мобильный вариант. Для этого покупатель программы получает как минимум одну ключевую дискету, гарантирующую нормальную работу программы на любом стандартном ПК (именно с этой целью в модуле используется широко распространенный формат дискет емкостью 360 Кбайт). В то же время жесткая привязка программы к дискете создает вполне понятные неудобства пользователю. Эти неудобства можно устранить, если разрешить пользователю осуществлять самостоятельную установку программы на жесткий диск, т.е. создавать легальные стационарные варианты программы. Чтобы процесс тиражирования был контролируем, каждая установка программы на ЖД осуществляется только при наличии ключевой дискеты, при этом программа ведет подсчет общего количества созданных с ее помощью стационарных копий. Как показывает практика, ограничение количества установок программы на ЖД является очень важным психологическим фактором, заставляющим покупателя крайне бережно относиться к ключевой дискете и не тиражировать программу без действительной надобности.

В модуле F_Prot реализована несложная защита программы от трассировки. С этой целью в ключевых местах проверки легальности используются простенькие ловушки TrassBlockl и TrassBIock2, обеспечивающие зацикливание программы в случае ее трассировки. Замечу, что процедура TrassBlockl использует модификацию кода программы с последующим восстановлением кода в случае, если трассировка не обнаружена. Таким образом, Вы можете многократно повторять выполнение этой процедуры без «зависания» программы. Однако она реализована в виде INLINE—макроса, поэтому взломщику придется бороться с ней всякий раз, когда она вызывается (чем чаще вызывается эта процедура, тем больше ее копий' используется в коде программы и тем труднее трассировка программы и ее взлом). Процедура TrassBIock2 контролирует скорость выполнения эталонного участка программы.

Процедура ProtCheck вызывается из защищаемой программы всякий раз, когда требуется установить легальность копии. Ее заголовок имеет следующий вид:

Procedure ProtCheck(var Norma,Alarm; var Res: Integer)

В теле процедуры параметры—переменные Norma и Alarm трактуются как параметры процедурного типа

type

ProcType = Procedure;

т.е. являются адресами двух процедур без параметров. Процедура Alarm вызывается в случае, если программа обнаружила признаки нелегального копирования, а Norma — если эти признаки отсутствуют. В переменной Res возвращается результат работы ProtCheck: 0 — если выполнялась процедура Norma (легальная копия), 1 — выполнялась Alarm (нелегальная копия), 2 — не выполнялась ни та, ни другая процедура, так как программа


h0201.htm

не обнаружила дискету в приводе ГД и не смогла проверить легальность

КОПИИ.

Процедура ProtCheck начинает работу с проверки поля Hard в глобальной типизированной константе Key. Это поле используется для анализа стационарности программы: если поле имеет значение 0, реализуется контроль мобильного варианта, в противном случае — стационарного варианта (установка поля Hard и всей константы Key осуществляется с помощью функции SetOnHD, см. ниже).

При контроле мобильного варианта программа пытается прочитать сначала на диске А, а если это не удается — на диске В ключевой сектор (первый сектор на нулевой поверхности дорожки номер 40) размером 256 байт. Этот сектор должен содержать следующую информацию:

Номер байта | Назначение
1 | Ключ для шифровки содержимого сектора с помощью операции XOR
17 | Количество уже созданных стационарных копий
200 | Максимальное количество стационарных копий (если 255 — количество копий не ограничено)
256 | Контрольная сумма со 2—то по 255—и байт

Если поле Hard константы Key содержит ненулевое значение, осуществляется контроль стационарного варианта. В этом случае поле Dat содержит эталон даты создания ПЗУ, а поле Hard используется как ключ для шифровки этого поля с помощью операции XOR.

Важно заметить, что если контроль стационарного варианта дает отрицательный результат (нелегальная копия), автоматически осуществляется анализ мобильного варианта (контроль дискеты). Таким образом, любая копия программы гарантированно работает, если в распоряжении пользователя есть ключевая дискета. Однако после правильной установки программы на жесткий диск с помощью процедуры SetOnHD программа может работать и без этой дискеты до тех пор, пока она не будет перенесена на новый компьютер, дата создания ПЗУ которого отличается от эталонной.

Для правильного создания стационарной копии программы используется функция SetOnHD, имеющая следующий заголовок:

Function SetOnHD: Integer;

Перед использованием функции SetOnHD необходимо любыми стандартными для ДОС средствами скопировать программу в один из каталогов жесткого диска. Эта функция вызывается в такой «нелегальной» копии, перед этим в любой привод ГД необходимо вставить ключевую дискету со снятой защитой от записи (с незаклеенной прорезью). Результат, возвращаемый функцией, имеет следующий смысл:

— 1 — в привод ГД не вставлена дискета;

— 2 — в привод вставлена дискета не эталонного типа (не 360 Кбайт или нет скрытого сектора);

—3 — дискета защищена от записи или при записи на нее возникла ошибка;


h0202.htm

—4 — данный вариант программы не скопирован предварительно на жесткий диск;

—5 — ошибка доступа к жесткому диску (программа не может прочитать собственный файл или не может записать в него новое значение константы Key);

— 6 — исчерпан лимит стационарных копий;

— 7 — данная программа уже представляет собой стационарный вариант программы, т.е. константа Key в ней уже определена.

Любое неотрицательное значение результата свидетельствует об успешном создании стационарной копии и равно количеству еще не использованных установок программы на жесткий диск.

В ходе установки программа контролирует ключевую дискету, затем определяет характерные признаки данного ПК и заносит эти признаки в константу Key. Поскольку защищается только тот экземпляр программы, в котором вызвана функция SetOnHD, программист должен предусмотреть соответствующий вариант запуска программы. Например, он может проанализировать ключи команды запуска с целью проверки специального ключа создания стационарного варианта или предусмотреть соответствующую опцию в диалоговом меню, создаваемом программой в ходе работы.

Функция RemoveFromHD осуществляет обратные действия: уничтожает текущую стационарную копию и соответствующим образом увеличивает запас неизрасходованных установок программы. Она возвращает одно из следующих значений:

— 1 — в привод ГД не вставлена дискета;

— 2 — в привод вставлена дискета неэталонного типа (емкостью не 360 Кбайт или нет скрытого сектора);

—3 — дискета защищена от записи или при записи на нее возникла ошибка;

—4 — данный вариант программы не скопирован предварительно на жесткий диск;

—5 — ошибка доступа к жесткому диску (программа не может прочитать собственный файл или не может записать в него новое значение константы Key).

Любое неотрицательное значение свидетельствует об успешном удалении стационарной копии и равно количеству еще не использованных установок программы на жесткий диск.

7.4.2. Тестовая программа

Следующая программа иллюстрирует некоторые приемы работы с модулем F_Prot. Программа анализирует ключи запуска: если используется ключ /SET, осуществляется установка программы на жесткий диск, если ключ /REMOVE, уничтожается стационарная копия программы, если этих ключей нет в команде запуска, программа осуществляет контроль легальности копии. Ключевая дискета должна быть предварительно подготовлена с помощью программы Diskette (см. прил.ПЮ.1).


h0203.htm

1 Эта программа проверяет легальность своей \ \ копии за счет контроля ключевой дискеты. \ +-_———————_-__-_————————__——————+^

Uses F_Prot;

Procedure Alarm; Far;

{Получает управление, если копия нелегальна} begin

WriteLn('Нелегальная копия') end;

;•————————————_

Procedure Norma; Far;

{Получает управление в случае легальной копии} begin

WriteLn('Легальная копия') end;

^—————————.——;

Function ParStr: String;

{Возвращает параметр вызова (заглавными буквами)} var

S: String;

k: Byte;

begin

S := ParamStr(1);

for k := 1 to Length(S) do S[k] := UpCase(S[K]);

ParStr := S end;

^————————————;

var

pl,p2: Pointer;

d: Integer;

dsk: Byte;

begin {Главная программа} pi := @Norma;

p2 := @Alarm;

if ParStr='/SET' then

WriteLn('Установка на ЖД: ",SetOnHD) else

if ParStr='/REMOVE' then

•WriteLn('Удаление с ЖД: ',RemoveFromHd) else begin

ProtCheck(pl,p2,d) ;

WriteLn('Результат проверки: ',d) end end.


h0204.htm

Глава 8 РАБОТА В СРЕДЕ BORLAND PASCAL

Одновременно с Турбо Паскалем 7.0 фирма Borland выпустила на рынок более мощную систему программирования Borland. Pascal with Objects 7.0. В состав этой системы входят три среды программирования: Borland Pascal for Windows (BPW), Borland Pascal (BP} и Турбо Паскаль. Среда BPW предназначена для создания программ, работающих под управлением операционной системы Windows, Турбо Паскаль — для работы с MS-DOS, а BP служит своеобразным мостом между этими системами, позволяя создавать программы как для MS-DOS, так и для Windows. Все программы, созданные с помощью Турбо Паскаля, могут без каких-либо переделок транслироваться средой BP, но не наоборот, т.к. BP имеет более мощные возможности. Специфика создания программ для Windows такова, что программы Турбо Паскаля либо вовсе не могут использовать возможности этой операционной системы, либо вынуждены прибегать к помощи специальных средств модуля WinCRT для имитации среды MS-DOS.

8.1. ОСОБЕННОСТИ СРЕДЫ

Интегрированная среда BP содержится в файле ВР.ЕХЕ и запускается как и любая другая программа, рассчитанная на работу под управлением MS-DOS, например:

\bp\bin\bp

(в этом примере предполагается стандартное расположение файла ВР.ЕХЕ в подкаталоге BIN каталога BP на текущем диске). Сразу после запуска среда создает окно, внешне практически не отличающееся от окна среды TURBO.EXE.

8.1.1. Отличия в меню

Главными отличиями среды BP от Турбо Паскаля являются

• возможность выбора типа создаваемых программ (будет ли программа работать под управлением Windows, MS-DOS или она будет работать в защищенном режиме процессора);

• включение в ее меню средств работы с браузером — утилитой просмотра иерахических стурктур и поиска идентификаторов. С помощью браузера можно просмотреть иерархию (подчиненность) объектов и список модулей прграммы, просмотреть объявления в ней всех глобальных символов — процедур, функций, типов, констант и переменных, а при необходимости — получить список тех операторов программы, которые ссылаются на символ и т.д.

Эти особенности следующим образом отражены в выпадающих меню:

• в опции меню Search добавлены средства вызова браузера (подопции Previous browser — просмотр результата предыдущего обращения к


h0205.htm

Работа в среде Borland Pascal ?,05

браузеру; Objects — просмотр иерархии объектов; Units — просмотр используемых модулей; Globals — просмотр всех глобальных символов; Symbol — поиск конкретного символа в программе);

• в опции Compile вместо подопции Destination, управляющей размещением исполняемой программы в среде Турбо Паскаля (в оперативной памяти или на диске) используется подопция Target, с помощью которой можно выбрать тип программы [Windows, MS-DOS или защищенный режим);

• в опции Tools к утилите Сгер добавлены вызовы компилятора Turbo Assembler, отладчика Turbo Debugger и средства наблюдения за исполняемыми программами Turbo Profiler,

• в опции Options добавлена подопция Browser, с помощью которой можно настроить браузер.

Замечу, что после выбора типа программы, отличного от MS-DOS, в меню исчезнут или станут запрещенными для выбора все опции встроенного отладчика, т.к. отладка программ д^я защищенного режима и для Windows может проходить только под управлением отладчика Turbo Debugger, входящего в комплект поставки Borland Pascal with Objects 7.0.

8.1.2. Использование защищенного режима

Защищенный режим работы процессоров 80х86 — это особое состояние процессора, в котором ему доступны команды, неиспользуемые в обычном, незащищенном режиме. В защищенном режиме процессор применяет другую схему адресации (см. п.8.2.1), что дает ему возможность адресовать память практически неограниченного размера.

Среда ВР не только позволяет создавать программы, рассчитанные на защищенный режим работы процессора, но и сама использует этот режим для доступа к дополнительной памяти, в которой она размещает таблицы компилятора и компоновщика. Это дает возможность создавать крупные программные проекты непосредственно в среде ВР без помощи внешнего компилятора ВРС.ЕХЕ.

8.1.3. Работа с браузером

Чтобы браузер смог нормально работать с Вашей программой, она должна быть откомпилирована в режиме {$L+,D+,Y+}, т.е. с подключением к ней всей отладочной информации. Поместите указанную директиву компилятора в начало Вашей программы или убедитесь в том, что активны (отмечены крестиком) опции Debug Information, Local symbols и Symbol information диалогового окна Options/Compiler, и откомпилируйте программу перед тем, как обратиться к браузеру.

Просмотр объектов

Для просмотра иерархии объектов (если, разумеется, программа использует ООП) следует вызвать меню Search/Objects. На экране появится дерево наследования всех объектов программы. Если дважды щелкнуть мышью на каком-либо объекте или выделить объект указателем и нажать


h0206.htm

Enter, раскроется дополнительное окно, в котором можно просмотреть информацию об объекте: если щелкнуть по кнопке 5 в верхней строке окна или нажать клавишу S, в окне будут перечислены все дополнительные поля и дополнительные и перекрытые методы объекта; если щелкнуть по / или нажать клавишу / — будет показан непосредственный родитель объекта; если щелкнуть (нажать) R — в окне появится список всех строк исходной программы, в которых есть ссылки на объект. Для перехода к тексту программы необходимо либо дважды щелкнуть по объекту, полю или методу мышью при нажатой и удерживаемой клавише Ctrl. либо выделить нужную строку окна указателем и нажать Ctrl—Enter.

Просмотр модулей

Для просмотра модулей необходимо обратиться к опции Search/Units. Браузер покажет список всех используемых в программе модулей в алфавитном порядке. После двойного щелчка по имени модуля раскроется окно с перечислением всех объявленных в модуле глобальных определений. Двойной щелчок с удерживаемой Ctrl покажет место в программе, где есть ссылка на модуль или его интерфейсный объект.

Глобальные символы

Для показа всех глобальных символов в программе и во всех используемых в ней модулях предназначена опция Search/'GIobals. Символы перечисляются в алфавитном порядке с указанием их типа (переменная, константа, метка, функция и т.д.). Двойной щелчок на любом символе показывает более подробную информацию о нем*.

Поиск символа

Эту возможность удобно использовать для быстрого поиска в тексте крупной программы тех или иных подпрограмм. Для этого установите текстовый курсор на имя процедуры или функции и вызовите опцию Search/Symbols. В строке ввода диалогового окна опции будет показано имя и для поиска текста подпрограммы теперь достаточно нажать Enter.

8.2. ОСОБЕННОСТИ ЗАЩИЩЕННОГО РЕЖИМА

Сразу после включения ПК процессор начинает работать в обычном режиме, который называется реальным. В этом режиме он способен адресовать оперативную память в пределах первого мегабайта и никак не вмешивается в работу прикладной программы, позволяя ей использовать все системные ресурсы по своему усмотрению. В реальном режиме могут работать любые процессоры в IBM—совместимых ПК. В отличие от этого защищенный режим возможен только в процессорах 80286 и более поздних — вплоть до Pentium, В этом режиме процессор осуществляет аппаратную защиту системных областей памяти (отсюда — название режима) и при—

1 Для символов стандартных модулей, откомпилированных без отладочной информации, получить детали невозможно.


h0207.htm

меняет другую, чем в реальном режиме, схему адресации, позволяющую программам использовать всю имеющуюся в ПК оперативную память. В дальнейшем я буду описывать особенности защищенного режима применительно к современным процессорам 80386, 80486 и Pentium и при необходимости упоминать об устаревших процессорах 80286, чьи возможности гораздо скромнее.

К сожалению, MS-DOS не поддерживает защищенный режим. Однако прикладные программы, стартующие под ее управлением, могут перевести процессор в этот режим и использовать все его возможности, в том числе:

• адресацию памяти до 4 Гбайт (для 80286 — до 16 Мбайт);

• аппаратную поддержку параллельно выполняемых программ (многозадачность);

• аппаратную поддержку так называемой виртуальной памяти, которая используется подобно оперативной памяти, но может существенно ее превышать (эта возможность отсутствует у процессора 80286).

8.2.1. Адресация памяти

Для адресации памяти в реальном режиме процессор использует два регистра, в одном из которых хранится сегмент, а в другом — смещение. Их совокупность определяет логический адрес памяти, физический адрес получается сдвигом содержимого регистра сегмента на 4 разряда влево и сложением полученного с содержимым регистра смещения. Такая схема реализуется аппаратно и дает 20—разрядный физический адрес в пределах первого мегабайта оперативной памяти.

В защищенном режиме также используются два регистра для логического адреса: селектор и смещение. Регистр селектора не сдвигается влево, как в реальном режиме, а указывает на один из элементов так называемой таблицы дескрипторов. В отличие от реального режима регистр смещения содержит 32 разряда, т.к. в защищенном режиме сегмент может быть любого размера вплоть до 4 Гбайт (в процессоре 80286 используется 16-разрядный регистр смещения и поэтому размер используемых в нем сегментов по—прежнему составляет 64 Кбайт). Совместное использование выбираемого селектором дескриптора и смещения в конечном счете формирует физический адрес (см. рис.8.1).

Важную роль в этой схеме играет таблица дескрипторов, 8—байтные элементы которой хранят три поля: базовый адрес, предел и поле доступа. Базовый адрес используется для получения физического адреса, предел содержит размер сегмента в байтах или страницах по 4096 байт, а поле доступа — ряд признаков, определяющих способ использования сегмента. В защищенном режиме сегменты могут быть либо сегментами кода, либо сегментами данных. В сегмент кода нельзя записывать информацию, а в сегменте данных нельзя исполнять программу или какую-либо ее часть. Тип сегмента хранится в поле доступа и, если программа нарушила правила доступа к сегменту (например, попыталась изменить собственный код), возникает аппаратное прерывание, которое обычно приводит к выгрузке программы из памяти. Другим признакоМг хранящимся в поле доступа, является уровень привилегий, которыми обладает владеющая


h0208.htm

сегментом программа. Для этого признака выделено 2 бита, поэтому в защищенном режиме используется 4 уровня привилегий, причем нулевой уровень — высший.

Логический адрес Логический адрес 15 32 16 16

э) б) Рис.8.1. Адресация в защищенном режиме: а) в процессорах 80386/80436;

б) в процессорах 80286

8.2.2. Многозадачность

Программы с нулевым уровнем привилегий используют все возможности процессора, в том числе они способны изменять содержимое таблицы дескрипторов и переводить процессор обратно в реальный режим. Обычно этот уровень назначается наиболее важным программам операционной системы. Прикладные программы, как правило, используют низший, третий уровень привилегий. Таким образом, в защищенном режиме на аппаратном уровне реализован механизм регулируемого доступа к ресурсам компьютера и прежде всего — к памяти. Этот механизм обеспечивается привилегированностью программы, т.е. теми «полномочиями», которыми наделила программу операционная система.

Поскольку обычно прикладная программа имеет лишь минимальный уровень привилегий, она не в состоянии изменить текущего распределения ресурсов и вынуждена обращаться за помощью к операционной системе. В защищенном режиме одновременно в памяти должны присутствовать как минимум две программы: операционная система (точнее, ее наиболее важная часть, называемая резидентным ядром) и прикладная программа.


h0209.htm

Это и есть многозадачность. Конечно, можно написать программу, которая будет совмещать в себе обе функции и, следовательно, монопольно владеть всеми ресурсами. Однако на практике это не делается, т.к.' операционные системы и специальные расширители ДОС, работающие в защищенном режиме, берут на себя массу черновой работы, избавляя программиста от множества ненужных хлопот.

Таким образом, важной отличительной особенностью защищенного режима является то, что прикладная программа уже не владеет всеми ресурсами процессора монопольно, как это было в реальном режиме. В частности, чтобы обратиться к тому или иному порту ввода/вывода или получить в свое распоряжение память, она должна обратиться к ядру операционной системы.

Как уже отмечалось, среда ВР готовит программы для работы под управлением трех типов операционных систем: Windows, MS-DOS и так называемого расширителя ДОС. Последний представляет собой набор программ, обеспечивающих интерфейс высокого уровня для программы, работающей в защищенном режиме.

8.2.3. Виртуальная память и перемещение сегментов

В описывающих сегменты дескрипторах имеется признак того, находится ли сегмент в данный момент в оперативной памяти. Если программа обращается к сегменту, который не загружен в память, возникает аппаратное прерывание и управление передается резидентному ядру операционной системы, которая может загрузить образ этого сегмента с диска. Так реализуется механизм виртуальной памяти. Виртуальная память работает подобно оверлею и делает ненужным его использование в защищенном режиме.

При загрузке дискового сегмента ОС проверяет наличие свободного пространства памяти. Если памяти недостаточно, ОС выгружает часть сегментов на диск1 и/или перемещает сегменты так, чтобы освободить требуемый объем. При перемещении сегмента соответствующим образом изменяется связанный с ним дескриптор, однако владеющая сегментом программа обычно не замечает этого изменения, т.к. для доступа к сегменту она использует селектор, указывающий на нужный дескриптор, а содержимое селектора не меняется. Если программа хочет получить доступ к конкретному физическому пространству памяти, она должна предварительно дать знать об этом ОС, которая в этом случае помечает сегмент как неперемещаемый. Такая процедура называется фиксацией сегмента. Фиксация обычно необходима при работе с кучей, т.к. только в этом случае связанный с кучей указатель может использоваться в качестве физического адреса. После завершения обмена данными с сегментом, программа должна снять фиксацию (разблокировать) сегмент, чтобы ОС смогла при необходимости его переместить или выгрузить на диск.

' Выгружаются на диск только сегменты данных. Д?ш сегментов кода вместо выгрузки операционная система помечает сегмент как свободный и использует его пространство для размещения дисковой памяти.


h0210.htm

Глава 9

ПРОГРАММИРОВАНИЕ ДЛЯ ЗАЩИЩЕННОГО РЕЖИМА

9.1 РАСШИРИТЕЛЬ ДОС

Программы для защищенного режима, создаваемые средой ВР, работают под управлением расширителя ДОС, который называется RTM [Run—Time Manager — администратор периода исполнения программы). Расширитель ДОС автоматически пристыковывается к программе и первым получает управление после ее загрузки. Он переводит процессор в защищенный режим работы и предоставляет программисту богатый набор возможностей этого режима с помощью процедур и функций, реализованных в модуле WinAPI. При попытке программы завершить свою работу с помощью обращения к функции $4С прерывания $21 расширитель переводит процессор в реальный режим и передает управление ДОС.

Расширитель ДОС является посредником между программой и так называемым сервером DPMI, который, собственно, и реализует все запросы программы (см. рис.9.1). Специально для целей работы в защищенном режиме разработан промышленный стандарт DPMI (DOS—Protected Mode Interface — интерфейс для защищенного режима ДОС). В этом стандарте определен набор системных прерываний, с помощью которых программа удовлетворяет все свои запросы в защищенном режиме. ВР использует сервер DPMI (файл DPMI16BI.OVL}, основанный на версии 0.9 стандарта, и дополняет его возможности по части вызова программных прерываний ДОС и BIOS.

Программа

Расширитель ДОС

DPMI-сервер

MS-DOS Рис.9.1. Взаимодействие программы с MS-DOS в защищенном режиме

Интерфейс DPMI документирован и программа при желании может использовать обращение непосредственно к серверу DPMI с помощью


h0211.htm

Программирование для защищенного режима 211

программного прерывания $31. Однако низкоуровневое программирование доступа к серверу менее эффективно, чем использование функций WinAPI, и в этой книге не рассматривается.

9.2. МОДУЛЬ WINAPI

Расширитель RTM с помощью средств модуля WinAPI реализует '.од множество интерфейса Windows для прикладных программ. Это означает, что некоторые возможности, используемые Windows— программами, становятся доступными также программе в защищенном режиме. Прежде всего это касается так называемых динамически подключаемых библиотек DLL (Dynamic—Link Library]. DLL—библиотеки подобно TPU— файлам хранят откомпилированные и готовые к использованию подпрограммы, но в отличие от модулей Турбо Паскаля они не связываются компоновщиком с телом программы, а существуют в виде отдельных дисковых файлов. При обращении к той или иной подпрограмме DLL расширитель проверяет ее наличие в оперативной памяти и при необходимости считывает библиотеку с диска. Отработавшая библиотека может удаляться из оперативной памяти, чтобы освободить место другой библиотеке или загружаемому с диска сегменту. Интерфейс взаимодействия программы с библиотекой в точности соответствует принятому в Windows, что, с одной стороны, открывает программе доступ к уже существующим в Windows библиотекам, а с другой стороны, позволяет программисту готовить собственные DLL— библиотеки для использования в защищенном режиме и/или в Windows (техника создания DLL — библиотек обсуждается в п.9.3).

Другой особенностью модуля WinAPI является включение в него Windows— средств работы с ресурсами. • Ресурсы — это специальным образом откомпилированные двоичные файлы, которые содержат данные и которые на этапе компоновки пристыковываются к исполняемому файлу программы. Обычно в ресурсах хранятся различного рода изображения (пиктограммы, курсоры, рисунки и т.п.), используемые Windows— программой для создания графического экрана. При работе в защищенном режиме программе недоступны мощные графические возможности Windows и поэтому нет смысла хранить в ресурсах графические образы. В связи с этим в WinAPI включены ограниченные средства доступа к ресурсам: с их помощью можно получить только строковые ресурсы и ресурсы, определяемым пользователем.

Многие из рассматриваемых ниже подпрограмм используют так называемый экземпляр программы — специальный дескриптор (Instance), связанный с текущей программой. Необходимость в этом дескрипторе вытекает из многозадачности Windows, под управлением которой одновременно может выполняться несколько программ, в том числе — несколько копий одной и той же программы. Экземпляр программы определяет, является ли данная программа единственной или в оперативной памяти существуют ее копии. В последнем случае Windows не загружает в память сегменты кода программы, а предоставляет копии только новые сегменты данных. Кроме того, копии используют ресурсы первого экземпляра в режиме разделяемой библиотеки. При работе в защищенном


h0212.htm

212___________________________________________________Глава 9

режиме расширитель RTM создает для программы дескприптор экземпляра и помещает его в переменную hinstance системного модуля System.

И последнее замечание, прежде чем мы перейдем к рассмотрению средств модуля WinAPI. Windows— программа имеет доступ к двум кучам — к локальной и к глобальной. Локальная куча имеет небольшой размер и принадлежит только данному экземпляру программы. Глобальная куча — это вся свободная в данный момент память. В защищенном режиме нет локальной кучи, поэтому модуль WinAPI содержит средства работы только с глобальной кучей (функции GIobaIXXXX).

В следующей таблице перечислены процедуры и функции модуля WinAPI.

Имя | Назначение
 | Управление памятью
GetFreeSpace | Возвращает общее количество свободной памяти
GlobalAlloc | Резервирует блок памяти
GlobalAllocPtr | Резервирует память и возвращает ее физический адрес
GlobalCompact | Реорганизует память так, чтобы обеспечить непрерывное сво —
 | бодное пространство заданного размера
GlobalDiscard | Выгружает блок памяти на диск
GlobalDosAlloc | Распределяет память в первом мегабайте
GlobalDosFree | Освобождает память, полученную с помощью CetDosAlloc
GlobalFix | Фиксирует блок памяти
GlobalFlags | Возвращает флаги и счетчик блокировок блока памяти
GlobalFree | Освобождает блок памяти
GlobalFreePtr | Освобождает блок, выделенный с помощь. GlobalAllocPtr
GlobalHandle | Возвращает дескриптор блока памяти по его адресу
GlobalLock | Фиксирует блок памяти, связанный с дескриптором
GlobalLockPtr | Фиксирует блок памяти, связанный с указателем
GlobalLRUNewest | Делает блок выгружаемым в последнюю очередь
GlobalLRUOldest | Делает блок выгружаемым в первую очередь
GlobalNotify | Устанавливает процедуру оповещения программы о выгрузке
 | блока памяти
GlobalPageLock | Фиксирует страницу памяти
GlobalPtrHandle | Возвращает дескриптор блока по указателю на него
GlobalReAlloc | Перераспределяет блок памяти
GlobalReAllocP-cr | Перераспределяет блок, выделенный с помощью GlobalAllocPtr
GlobalSize | Возвращает размер блока памяти
GlobalUnfix | Исключает блок из линейного адресного пространства и делает его
 | перемещаемым
GlobalUnlock | Отменяет фиксацию блока, связанного с дескриптором
LockSegment | фиксирует сегмент
UnLockSegment | Разблокирует сегмент
 | Управление селекторами
AllocDStoCSAlias | Преобразует селектор сегмента данных к селектору кодового
 | сегмента
AllocSelector | Создает новый селектор
ChangeSelector | Изменяет тип селектора
FreeSelector | Очищает селектор
GetSelectorBase | Возвращает базовый адрес селектора
GetSelectorLimit | Возвращает предел селектора
PrestoChangoSelector | Изменяет тип селектора
SetSelectorBase | Устанавливает новый базовый адрес селектора
SetSelectorLimit | Устанавливает новый предел селектора


h0213.htm

 | Управление модулями
FreeLibrary | Освобождает динамическую библиотеку
GetModuleFileName | Возвращает маршрут поиска и полное имя выполняемого файла
 | загруженной программы (модуля)
GetModuleHandle | Возвращает дескриптор загружаемого модуля
GetModuleUsage | Возвращает счетчик вызовов модуля
GetProcAddress | Возвращает точку входа в процедуру модуля
LoadLibrary | Загружает ML—библиотеку
 | Управление ресурсами
AccessResource | Открывает доступ к ресурсу
FindResource | Ищет ресурс
FreeResource | Освобождает ресурс
LoadResource | Загружает ресурс пользователя
LoadString | Загружает строковый ресурс
LockResource | Фиксирует ресурс
SizeOfResource | Возвращает размер ресурса
 | Функции разного назначения
DOS3Call | Реализует доступ к прерыванию ДОС
FatalExit | Посылает состояние программы отладчику (используется в отла
 | дочном режиме)
GetDosEnvironment | Передает программе переменные окружения ДОС
GetWinFlags | Возвращает конфигурацию памяти
MessageBox | Выводит текстовое сообщение и ждет выбора пользователем
 | одного из вариантов продолжения

9.2.1. Управление памятью

В описании процедур и функцийг связанных с управлением памятью, используется понятие «дескриптор» (ему соответствует тип THandIe). Для защищенного режима дескриптор совпадает с селектором, для Windows это не так.

Функция GetFreeSpace. Заголовок:

Function GetFreeSpace(Flags: Word): Longint;

Возвращает размер свободной памяти в байтах. Параметр Flags игнорируется и может быть любым.

функция GlobalAlloc. Заголовок:

Function GlobalAlloc(Flags: Word; Bytes: Longint): THandle;

Резервирует в памяти блок нужного размера Bytes и возвращает его дескриптор или 0, если нет памяти. Параметр Flags указывает тип блока и задается комбинацией следующих флагов:

Флаг | Смысл
gHND | Комбинация флагов gmemMovcable и gmemZeroInit.
gmem DDEShare | Определяет разделяемую память. Используется в операциях динами —
 | ческого обмена данными DDE и эквивалентен gmemShared.
gmem Discardable | Определяет выгружаемый на диск блок. Этот флаг не может комби —
 | нироваться с gmemMoveable.
gmem Fixed | Определяет фиксированный блок. Этот флаг не может комбинироваться


h0214.htm

214 Глава 9

 | с gmemMoveable.
gmem Lower | Этот флаг игнорируется.
gmem Moveable | Опреде.1яет перемещаемый блок.
gmemNoCompact | Этот блок не выгружается и не участвует в реструктуризации памяти
 | выполняемой функцией GlobalCompact.
gmem NoDiscard | Определяет невыгружаемый блок.
gmem Notify | Требует оповещения программы при выгрузке блока на диск.
gmem Share | Определяет блок, который будет использоваться несколькими про —
 | граммами.
gmem Zerolnit | Этот блок при распределении в памяти заполняется нулями.
gPTR | Комбинация флагов gmeniFixed и gmemZeroInit

Функция GlobalAllocPtr . Заголовок:

Function GlobalAllocPtr(Flags: Word; Bytes: Longint): Pointer;

Резервирует блок памяти и возвращает указатель на него. Эквивалент вызовов GlobalAlloc и ClobalLock.

функция GlobalCompact. Заголовок:

Function GlobalCompact(MinFree: Longint): Longint;

Реструктурирует память так, чтобы обеспечить не менее MinFree байт свободного непрерывного пространства (если это возможно), и возвращает наибольшее непрерывное пространство в байтах. Если MinFree=0, функция не выгружает блоки на диск и возвращает размер непрерывной области, которая получится в результате выгрузки. Во всех случаях функция вначале перемещает блоки с флагом gmem_Moveable. Если после этого нет MinFreeoO байт непрерывного пространства, она выгружает блоки с флагом gmem_Discardable.

Функция Global Pis card. Заголовок:

Function Global-Discard (Mem: THandle) : THandle;

Выгружает на диск блок памяти, связанный с дескриптором Мет, и возвращает дескриптор блока, если операция прошла успешно, или NIL, если закончилась неудачей.

Функция GlobalDosAlloc. Заголовок:

Function GlobalDosAlloc(Size: Longint): Longint;

Распределяет память размером Size байт в первом мегабайте памяти. Возвращаемое значение содержит сегмент в старшем слове и селектор в младшем. Программа может использовать сегмент для доступа к памяти в реальном режиме и селектор — в защищенном. Если расширитель ДОС не может выделить память, функция возвращает 0.

Функция GlobalDosFree . Заголовок:

Function GlobalDosFree(Selector: Word): Word;


h0215.htm

Программирование для защищенного режима 215

Освобождает память, выделенную с помощью GIobalDosAlloc. Selector — селектор блока памяти. Возвращает селектор блока, если операция прошла успешно, или 0, если неудачно.

Процедура GlobalFix. Заголовок:

Procedure GlobalFix(Mem: THandle);

Делает блок, связанный с дескриптором Мет, неперемещаемым. фиксированные блоки препятствуют эффективной работе менеджера памяти, поэтому следует разблокировать блок с помощью GIobaIUnFix сразу, как только это станет возможным.

Функция GlobalFlaqs. Заголовок:

Function GlobalFlags(Mem: THandle): Word;

Возвращает информацию о блоке, связанном с дескриптором Мет:

флаги памяти в старшем байте и счетчик блокировок — в младшем. Для тестирования флагов следует использовать маски из флагов gmem_Shared, gmem_Discard и gmem_Discarded (последний флаг означает, что блок выгружен на диск, остальные см. GlobalAIloc). Для получения значения счетчика блокировок следует использовать маску gmem_LockCount.

Функция GlobalFree. Заголовок:

Function GlobalFree(Mem: THandle): THandle;

Освобождает глобальный блок памяти, связанный с дескриптором Мет. Возвращает десриптор блока, если операция прошла успешно, или ноль — а противном случае.

Функция GobalFreePtr. Заголовок:

Function GobalFreePtr(P: Pointer): THandle;

Освобождает блок памяти, созданный с помощью обращения к GlobalAllocPtr.

функция GlobalHandle. Заголовок:

Function GlobalHandle(Mem: Word): Longint;

Возвращает селектор (в старшем слове) и дескриптор (в младшем) блока по его селектору Mem или ноль, если с блоком не связан дескриптор.

Функция GlobalLock. Заголовок:

Function GlobalLock(Mem: THandle): Pointer;

Фиксирует блок в памяти и возвращает его физический адрес. Функция увеличивает на единицу счетчик блокировок блока. Блок остается зафиксированным до тех пор, пока счетчик не станет равен нулю.

Функция GlobalLockPtr. Заголовок:

Function GlobalLockPtr(P: Pointer): Pointer;


h0216.htm

216___________________________________________________Глава 9

Аналогична GlobalLock, но использует указатель вместо дескриптора. Функция GlobalLRUNewest. Заголовок:

Function GlobalLRUNewest(Mem: THandle): THandle;

Делает блок, связанный с дескриптором Mem, самым «свежим» и тем самым уменьшает вероятность его выгрузки на диск.

Функция GlobalLRUOldest. Заголовок:

Function GlobalLRUOldest(Mem: THandle): THandle;

Делает блок, связанный с дескриптором Mem, самым «старым» и тем самым увеличивает вероятность его выгрузки на диск.

Процедура GlobalNotify. Заголовок:

Procedure GlobalNotify(NotifyProc: TFarProc);

Устанавливает процедуру оповещения программы: NotifyProc — адрес процедуры, которая будет вызыватся всякий раз перед выгрузкой на диск блока, помеченного флагом gmem_Notify.

Функция GlobalPaqeLock. Заголовок:

Function GlobalPageLock(Selector: THandle): Word;

Увеличивает на единицу счетчик блокировок страниц памяти, связанной с селектором Selector, и возвращает новое значение счетчика. Для каждого вызова этой функции программа должна обеспечить вызов функции GIobalPageUnlock, которая осуществляет обратные действия. Программа должна использовать эту функцию только при крайней необходимости.

функция GlobalPaqeUnLock. Заголовок:

Function GlobalPageUnLock(Selector: THandle): Word;

Уменьшает на единицу счетчик блокировок страниц памяти, связанной с селектором Selector, и возвращает новое значение счетчика.

Функция GlobalPtrHandle. Заголовок:

Function GlobalPtrHandle(P: Pointer): THandle;

По заданному адресу блока возвращает его дескриптор. Функция GlobalReAlloc. Заголовок:

Function GlobalReAlloc(Mem: THandle; dwSize: Longint;

Flags: Word): THandle;

Перераспределяет блок памяти, устанавливая для него новый размер и флаги. Возвращает дескриптор блока, если операция выполнена, или ноль — в противном случае.

Функция GlobalReAllocPtr. Заголовок:


h0217.htm

Программирование для защищенного режима 217

Function GlobalReAllocPtr(P: Pointer; Size: Longint;

Flags: Word): Pointer;

Разблокирует, перераспределяет и вновь блокирует связанный с указателем Р блок памяти.

Функция GlobalSize. Заголовок:

Function GlobalSize(Mem: THandle): Longint;

Возвращает размер в байтах блока памяти, связанного с дескриптором Мет.

Функция GlobalUnfix. Заголовок:

Function GlobalUnfix(Mem: THandle): Boolean;

Уменьшает на единицу счетчик блокировок блока, связанного с дескриптором Мет. Если счетчик стал равен нулю, блок можно перемещать.

Функция GlobalUnlock. Заголовок:

Function GlobalUnlock(Mem: THandle): Boolean;

Уменьшает на единицу счетчик блокировок блока, связанного с дескриптором Мет. Если счетчик стал равен нулю, блок можно перемещать и/или выгружать.

Функция LockSeqment. Заголовок:

Function LockSegment(Segment: Word): THandle;

Фиксирует сегмент Segment и возвращает сегмент данных, если функция выполнена, или ноль, если сегмент выгружен на диск или обнаружена ошибка. Если Segment^-1, фиксируется текущий сегмент данных.

Функция Segment Unlock. Заголовок:

Function SegmentUnlock(Segment: Word): THandle;

Уменьшает на единицу счетчик блокировок сегмента Segment. Результат, возвращаемый функцией, должен игнорироваться.

9.2.2. Управление селекторами

Функция AllocDStoCSAlias. Заголовок:

Function AllocDStoCSAlietS (Selector: Word): Word;

Преобразует селектор данных Selector к селектору кода и возвращает его. Эта функция позволяет программе готовить в сегменте данных исполняемый код и, после вызова функции, исполнить его.

Функция AllocSelector. Заголовок:

Function AllocSelecto-r (Selector: Word): Word;


h0218.htm

218___________________________________________________Глава 9

Создает новый селектор. Если параметр Selector — правильный селектор, функция создает точную его копию, если параметр равен нулю,— создает новый, неинициализированный селектор.

Функция FreeSelector. Заголовок.

Function FreeSelector(Selector: Word): Word;

Освобождает селектор Selector и делает его непригодным для далб— нейшего использования. Размер связанного с селектором сегмента не должен превышать 64 Кбайт, в противном случае могут быть разрушены селекторы, которые еще нужны программе.

9.2.3. Управление модулями

Процедура FreeLibrary. Заголовок:

Procedure FreeLibrary(Lib: THandle);

Уменьшает на единицу счетчик ссылок библиотеки, связанной с дескриптором Lib.

Функция GetModuleHandle. Заголовок:

Function GetModuleHandle(FileName: PChar): THandle;

Создает и возвращает дескриптор файла, содержащего исполняемую программу или библиотеку. FileName — ASCIIZ— строка с именем файла.

Функция GetModuleFileName. Заголовок:

Function GetModuleFileName(Module: THandle; FileName: PChar;

Size: Integer): Integer;

Возвращает в переменной FileName полное имя файла (с маршрутом поиска), связанного с дескриптором Module. Size — размер переменной FileName. Возвращает мину скопированного в FileName имени, если функция выполнена успешно, или 0, если возникла ошибка.

Функция GetModuleUsaqe. Заголовок:

Function GetModuleUsage(Module: THandle): Integer;

Возвращает счетчик ссылок для модуля, связанного с дескриптором Module. Счетчик ссылок увеличивается на единицу при каждом вызове LoadModule и уменьшается на единицу при вызове FreeModule.

Функция GetModuleAddress. Заголовок:

Function GetModuleAddress(Module: THandle; ProcName: PChar):

TFarProc;

В модуле, связанном с дескриптором Handle, ищет процедуру ProcName и возвращает адрес ее точки входа или NIL, если процедура не найдена. Параметр ProcName может содержать либо ASCIIZ— строку с именем процедуры, либо ее порядковый номер. В последнем случае порядковый


h0219.htm

номер помещается в младшее слово ProcName, а старшее должно содержать 0.

Функция LoadLibrary. Заголовок:

Function LoadLibrary(LibFileName: PChar): THandle;

Загружает файл DLL — библиотеки с именем LibFileName и возвращает его дескриптор. Функция ищет файл в следующем порядке:

• в текущем каталоге;

• в каталоге Windows;

• в системном каталоге Windows;

• в каталоге, из которого была запущена программа;

• в каталогах, определяемых переменной Path окружения ДОС;

• в сетевых каталогах.

Если значение, возвращаемое функцией, меньше hInstance_Error, оно определяет одну из следующих ошибок:

Значение | Смысл
о | Системе не хватает памяти для загрузки или файл поврежден и не читается
2 | Файл не найден
3 | Не найден маршрут поиска файла
5 | Попытка доступа к файлу из динамически связанной задачи или ошибка
 | разделения сетевого файла
6 | Библиотека требует отдельных сегментов данных для каждой задачи
8 | Не хватает памяти
10 | Неверная версия Windows
11 | Исполняемый файл испорчен или не соответствует формату исполняемого
 | файла Windows
12 | Библиотечный файл создан для другой операционной системы
13 | Библиотечный файл создан для MS-DOS 4.0
14 | Неизвестный тип исполняемого файла
15 | Попытка загрузить файл, рассчитанный на реальный режим работы Windows
 | ранних версий
16 | Попытка загрузить второй экземпляр библиотеки, которая загружена не в
 | режиме «только для чтения»
19 | Попытка загрузить сжатый исполняемый файл
20 | Неправильный файл DLL—библиотеки
21 | Библиотека рассчитана на 32 — разрядную среду

При вызове функции она вначале проверяет, была ли уже загружена требуемая библиотека. Каждый вызов функции LoadLibrary наращивает на единицу счетчик ссылок библиотеки, а каждый вызов функции FreeLibrary уменьшает на единицу этот счетчик.

9.2.4. Управление ресурсами

Функция AccessResource. Заголовок:

Function AccessResource(Instance, Reslnfo: THandler): Integer;

Здесь Instance — экземпляр программы (модуля); Reslnfo — дескриптор ресурса.


h0220.htm

функция открывает исполняемый файл программы (модуля), заданной дескриптором Instance и перемещает указатель файла на начало нужного ресурса. Дескриптор Reslnfo должен быть предварительно создан с помощью функции FindResource. Возвращает 0, если операция прошла успешно, или — 1, если это не так.

После использования ресурса программа должна закрыть файл с помощью вызова функции _lClose. На практике для доступа к ресурсу чаще используются функции LoadResource и LockResource.

Функция FindResource. Заголовок:

Function FindResource(Instance: THandle;

ResName, ResType: PChar): THandle;

Для экземпляра программы Instance ищет ресурс с именем ResName и типом ResType. Возвращает дескриптор ресурса, если ресурс найден, или О — если не найден. Для указания типа ресурса можно использовать следующие константы-_______________________

Константа | Тип ресурса
rtAcselerator | Клавиша быстрого выбора
rtBitMap | Растровое изображение
rt Cursor | Указатель мыши
rt Dialog | Диалоговое окно
rt Font | Шрифт
rt Menu | Меню
rt Icon | Пиктограмма
rtRCData | Ресурс пользователя
rt String | Строковый ресурс

Для защищенного режима доступны только строковые ресурсы и ресурсы пользователя.

В параметрах ResName и ResType могут передаваться ASCIIZ— строки или целочисленные идентификаторы. В последнем случае старшее слово соответствующего параметра должно содержать 0, а младшее — идентификатор. Если текстовая строка начинается символом #, остальная часть строки должна представлять собой правильную форму представления целого числа, которое считается целочисленным идентификатором. Например, строка '#100' означает целочисленный идентификатор 100.

Функция FreeRe source. Заголовок:

Function FreeResource(Resource: THandle): Boolean;

Уменьшает на единицу счетчик ссылок на ресурс, связанный с дескриптором Resource. Если счетчик стал нулевым, выгружает ресурс из памяти.

Функция LoadResource. Заголовок:

Function LoadResource(Instance, Reslnfo: THandle): THandle;

Для экземпляра программы Instance загружает в память ресурс, связанный с дескриптором Reslnfo. Дескриптор должен быть ранее создан с


h0221.htm

Программирование для защищенного режима 221

помощью обращения к FindResource. Каждый вызов LoadResource наращивает на единицу счетчик ссылок ресурса.

Функция LoadStrinq. Заголовок:

Function LoadString(Instance: THandle; ID: Word;

Buffer: PChar; MaxSize: Integer): Integer;

Для экземпляра программы Instance загружает из строкового ресурса в буфер Buffer строку с идентификатором ID. Длина буфера (вместе с терминальным нулем) задается параметром MaxSize. Возвращает длину загруженной строки или 0, если строка не найдена.

Функция LockResource. Заголовок:

Function LockResource(Res: THandler): Pointer;

Фиксирует в памяти ресурс, связанный с дескриптором Res, и возвращает указатель на первый байт ресурса. Каждый вызов функции LockResource увеличивает на единицу счетчик ссылок ресурса, каждый вызов UnlockResource уменьшает на единицу этот счетчик. Ресурс становится перемещаемым и может выгружаться, если его счетчик содержит 0.

Функция SizeOfResource. Заголовок:

Function SizeOfResource(Instance, Res: THandle): LongInt;

Для экземпляра программы Instance возвращает размер ресурса в байтах, связанного с дескриптором Res.

Функция UnlockResource. Заголовок:

Function UnlockResource(Res: THandle): Boolean;

Уменьшает на единицу счетчик ссылок на ресурс, связанный с дескриптором Res. Если счетчик стал нулевым, ресурс может быть выгружен из памяти.

9.2.5. Функции разного назначения

Процедура Dos3Call. Заголовок:

Procedure Dos3Call;

Позволяет программе вызвать прерывание ДОС $21. Доступ к этой процедуре возможен только на ассемблере.

Процедура FatalExit. Заголовок:

Procedure FatalExit(Code: Integer);

Передает текущее состояние защищенной программы внешнему отладчику. Используется только в отладочном режим. Вызов этой процедуры в рабочем режиме приведет к завершению работы программы.

Функция GetDosEnvironment. Заголовок.


h0222.htm

322__________________________________________________Глава 9

Function GetDosEnvironment: PChar;

Возвращает переменные окружения ДОС. Используется в DLL, т.к. в отличие от основной программы DLL не получают копию переменных окружения ДОС.

Функция GetVersion. Заголовок:

Function GetVersion: Longint;

Возвращает версию Windows или MS-DOS: старшее слово содержит номер версии, младшее — номер ревизии.

Функция GetWinFlaqs. Заголовок:

Function GetWinFlags: Longint;

Возвращает флаги Windows, содержащие информацию о конфигурации ОС и памяти. Возвращаемое значение может быть комбинацией следующих признаков:________________________________

Признак | Смысл
wf 80х87 | В системе имеется арифметический сопроцессор
wf CPU286 | Используется процессор 80286
wf CPU386 | Используется процессор 80386
wfCPU486 | Используется процессор 80486
wf Enhanced | Windows работает в расширенном 386 — режиме
wf Paging | Wndows работает на системе со страничной памятью
wf PMode | Используется защищенный режим процессора
wf Standard | Windows работает в стандартном режиме
wf Win286 | Эквивалент wfStandard
wf Win386 | Эквивалент wfEnhanced
wf DPMI | Используется DPMI— сервер

Функция MessaqeBox. Заголовок:

Function MessageBox(Handle: Word; Text, Header: PChar;

Flags: Word): Word;

Выводит текстовое сообщение, состоящее из двух строк, и ожидает ответа пользователя. Возвращает идентификатор ответа. Параметр Handle в защищенном режиме игнорируется и может быть любым.

Первая строка сообщения состоит из двух текстовых строк, разделенных двоеточием: Header — текстовая строка до двоеточия; Text — строка после двоеточия. Вторая строка сообщения определяется параметром Flags, который должен быть комбинацией следующих флагов:

Флаг | Смысл
mb0k | Вставить текст 'Ok (0):'
mb OkCance-L | Вставить текст 'Ok (0) Cancel (С):'
mbAbortRetryIgnore | Вставить текст'Abort (A) Retry (R) Ignore (I)
inbYesNoCancel | Вставить текст'Yes (Y) No (N) Cancel (0 :'
mbYesNo | Вставить текст ' Yes (Y) No (N) : '
mbRetryCancel | Вставить текст'Retry (R) Cancel (C) :'
S bDefButtonl | Сделать умалчиваемым 1 — и символ


h0223.htm

Программирование для защищенного режима 223

mb_DefButton2 ¦ Сделать умалчиваемым 2—и символ mb_DefButton3 ¦ Сделать умалчиваемьм 3-й символ

Функция возврашает одно из следующих значений:

Значение | Смысл
id0k id Cancel | Нажата клавиша «О» Нажата клавиша «С»
idAbort | Нажата клавиша «А»
idRetry | Нажата клавиша «R»
idIgnore | Нажата клавиша «I»
idYes | Нажата клавиша «X»
idNo | Нажата клавиша «N»

Если, например, сделан такой вызов функции:

MessageBox(0,'прекратить печать?', 'Принтер не отвечает',mb_YesNo+mb_DefButton2)

то на экран будет выведено:

Принтер не отвечает: прекратить печать? Yes (Y) No (N) :

Если в ответ нажата клавиша Enter, функция вернет значение id_No, так как параметр Flags содержит mb_DefButton2.

9.3. РАБОТА С ПАМЯТЬЮ

Для создания программы, работающей в защищенном режиме, выберите в среде ВР опцию Compile/Target и в появившемся диалоговом окне укажите Protected—mode. Получающийся в результате компиляции ЕХЕ— файл имеет два заголовка: стандартный заголовок MS-DOS и заголовок Windows. При запуске программы под управлением MS-DOS командный процессор COMMAND.COM использует заголовок ДОС для запуска небольшой стартовой программы, которая автоматически пристыковывается компилятором к исполняемому файлу. Эта программа осуществляет следующие действия:

• проверяет наличие DPMI— сервера и, если сервер не инсталирован, загружает его из файла DPMI16BI.OVL; если сервер инсталирован (обычно это означает, что программа запускается из расширенного режима Windows], стартовая программа не загружает его вновь;

• проверяет наличие в памяти расширителя ДОС и при необходимости загружает его из файла RTM.EXE (если программа запускается из другой программы, работающей в защищенном режиме, обе программы будут использовать один и тот же расширитель RTM};

• переключает процессор в защищенный режим и передает управление загрузчику исполняемых файлов расширителя ДОС.

Загрузчик расширителя читает Windows — заголовок исполняемого файла, загружает все указанные в нем DLL — библиотеки, затем загружает саму программу и передает ей управление.


h0224.htm

Таким образом, для нормальной загрузки программы необходимо, чтобы в текущем каталоге или в одном из каталогов, перечисленных в переменной окружения PATH, находились все используемые программой DLL— библиотеки, а также файлы DPMI16BLOVL и RTM.EXE.

Программирование в защищенном режиме почти не отличается от программирования для MS-DOS. Единственное, о чем не должен забывать программист, это о специфике использования памяти.

В защищенном режиме нельзя использовать абсолютные адреса, задаваемые директивой absolute. Точнее, их можно указывать только в сочетании с одним из следующих стандартных селекторов:

Seg0040 определяет начало области параметров BIOS;

SegAOOO начало видеопамяти адаптеров EGA/VGA в графическом режиме;

SegBSOO начало видеопамяти адаптеров CGA/EGA/VGA в текстовом режиме;

SegBOOO начало видеопамяти монохромных адаптеров.

Только с правильными селекторами можно использовать массивы памяти Mem, MemW и MemL. Селектором должен быть и первый параметр обращения к функции Ptr, которая используется для создания указателей.

В защищенном режиме размер кучи определяется объемом всей оператчвной памяти компьютера за вычетом загруженной программы и резидентных частей MS-DOS, расширителя ДОС и DPMI— сервера. Хотя функции ClobaIAIIoc и GlobalAllocPtr способны распределять в куче блоки очень большие блоки (до 64 Мбайт), использовать данные в крупных блоках можно только порциями по 64 Кбайт, т.к. смещение в указателях задается 16—разрядным словом. Учитывая это, расширитель ДОС при распределении в куче крупного блока создает несколько последовательно расположенных селекторов, каждый из которых (кроме, возможно, последнего) ссылается на участок памяти длиной 64 Кбайт. Возвращаемый функциями GlobaILock и GlobalAllocPtr указатель содержит селектор и смещение, определяющие адрес самого первого байта крупного блока. Для доступа к остальным байтам в этом случае можно использовать следующую функцию:

Function GetPtr(P: Pointer; Offset: LongInt): Pointer/begin

GetPtr := Ptr(

HiWord(LongInt(P)) + HiWord(Off set)*SelectorInc,

LoWord(LongInt(P)) + LoWord(Offset)) end;

При рализации этой функции используются два обстоятельства. Во-первых, старшее слово 32 — разрядного параметра Offset содержит количество блоков по 65535 байт и поэтому для получения селекторной части указателя это слово умножается на Selectorinc (вариант

round(Offset/65535)*SelectorInc

дает такой же результат, но реализуется значительно медленно). Во-вторых, предполагается, что сложение


h0225.htm

Программирование для защищенного режима 225

LoWord(LongInt(P)) + LoWord(Offset))

не приведет к переполнению значения Word. Это будет только тогда, когда смещение указателя Р нулевое. Если это не так, то в общем случае потребуется дополнительная проверка

if LongInt(LoWord(LongInt(P)))+LoWord(Offset)>$FFFF then {Наращиваем селекторную часть на Selectorinc}

К счастью, смещение в адресах, возвращаемых функциями GlobaILock и GlobalAllocPtr, всегда нулевое и функция не осуществляет ненужную проверку.

В следующей несложной программе иллюстрируется техника работы с большими блоками. Программа резервирует блок размером почти 1 Мбайт для распределения в нем 250000 значений типа Longint, заполняет этот массив монотонно возрастающими значениям от 1 до 250000 и затем находит сумму всех его элементов. Найденная сумма выводится вместе с теоретическим значением, что позволяет убедиться в достоверности результата.

{$N+,E+} {Используем сопроцессор для типа Сотр} Uses WinAPI;

Function GetPtr(P: Pointer; Offset: Longint'): Pointer;

begin

GetPtr := Ptr(

HiWord(LengIntCP)) + HiWord(Offset)*SelectorInc, LoWord(Longint(P)) + LoWord(Offset)) end;

type

PLongInt =ALongInt;

const

MaxSize = 250000;

var

Summ : Comp;

k : Longint;

Buffer: Pointer;

begin

Buffer := GlobalAllocPtr(gmem_Moveable,MaxSize*4^;

for k := 1 to MaxSize do

PLongInt (GetPtr (Buf fer, (k-DM))'" := k;

Summ := 0;

for k := 1 to MaxSize do

Summ := Summ + PLongInt(GetPtr(Buffer,(k-1)*4))л;

GlobalFreePtr(Buffer) ;

WriteLn(Summ:10:0, (1.O*MaxSize*MaxSize+MaxSize)/2:15:0) end.

(умножение на 1.0 в выражении

(l.O*MaxSize*MaxSize+MaxSize)/2


h0226.htm

необходимо для приведения операндов к вещественному типу; если этого не сделать, возникнет переполнение значения типа Word и будет напечатан неверный результат).

Расширитель ДОС для каждого загружаемого сегмента кода, который, как известно, не может изменяться, создает селектор—псевдоним, ссылающийся на тот же сегмент кода, но определенный как сегмент данных. Селектор—псевдоним располагается в таблице дескрипторов сразу за селектором кода, поэтому получить к нему доступ можно с помощью той же переменной Selectorlnc. Это открывает возможность создания самоизменяющихся программ. Если, например, требуется изменить 10—и по счету байт в коде процедуры МуРгос, можно использовать такой фрагмент программы:

var

Р: Pointer;

Р := Ptr(Seg(МуРгос)+SelectorInc, Ofs(MyProc));

Byt^GetPtrtPylO)'') := ....

В защищенном режиме программа не может ссылаться на модуль Overlay, использовать директивы {$0 . . . } и переменные OvrXXXX из модуля System, так как расширитель ДОС автоматически реализует все функции администратора оверлея. Для управления свойством выгружае— мости кодовых сегментов в среду ВР введена специальная директива компилятора {$S Flagi Flag]). В качестве параметров Flag в этой директиве должны использоваться следующие идентификаторы:

Идентификатор | Назначение
MOVEABLE | Сегмент может перемещаться в памяти
FIXED | Сегмент не может перемещаться
PRELOAD | Сегмент загружается в момент старта программы
DEMANLOAD | Сегмент загружается только при обращении к нему
DISCARDABLE | Сегмент можно удалять из памяти
PERMANENT | Сегмент нельзя удалять из памяти

По умолчанию каждый модуль компилируется с такой директивой:

{$S MOVEABLE DEMANLOAD DISCARDABLE}

Это означает, что соответствующий кодовый сегмент может перемещаться в памяти, загружается только когда ему передается управление и он может удаляться из памяти. При необходимости Вы можете переопределить умалчиваемые свойства, включив директиву $3 в самом начале программы или модуля. Если в директиву вставляются два противоположных по смыслу идентификатора, действует последний из них.

9.4. СОЗДАНИЕ И ИСПОЛЬЗОВАНИЕ РЕСУРСОВ

Как уже говорилось, ресурсы — это двоичные данные, создаваемые специальными редакторами ресурсов для нужд программы и пристыко— вываемые в конец исполняемого файла. Сразу же оговорюсь, что ресурсы


h0227.htm

Программ ирование для защищенного режима___________________________227

в защищенном режиме и ресурсы библиотеки Turbo Vision — это не одно и то же. Расширитель ДОС использует формат ресурсов Windows, которые обычно хранят элементы графического интерфейса и описание диалоговых окон. Поскольку защищенный режим не поддерживает графику, из всего многообразия ресурсных API— функций в модуль WinAPI включены только средства работы со строковыми ресурсами и ресурсами пользователя. Строковые ресурсы содержат пронумерованные строки. Программа получает строку из ресурса, ссылаясь на ее имя, т.е. примерно так же, как это делается в библиотеке TurboVision. Ресурс пользователя содержит произвольные двоичные данные, которые программа может использовать по своему усмотрению.

9.4.1. Создание ресурсов

Для создания ресурса любого типа можно использовать редактор ресурсов Resourse Workshop или один из компиляторов ресурсов — BRC.EXE или BRCC.EXE. Поскольку редактор ресурсов работает только в среде Windows, а эта операционная система необязательно установлена на Вашем ПК, дальше описывается процесс создания ресурсов с помощью компиляторов, которые работают под управлением MS-DOS.

Компилятор ресурсов получает текстовый файл описания ресурсов и производит двоичный ресурсный файл. По умолчанию расширение текстового файла — RC, а ресурсного файла — RES. Текст .КС—файла со— тавляется на специальном языке описания ресурсов.

Каждый ресурс в RC—файле содержит заголовок и описание. В заголовке, имеющем формат

[<ИМЯ_РЕСУРСА>] <ТИП_РЕСУРСА>

указывается имя ресурса и его тип. Имя ресурса — обязательный параметр для всех ресурсов, кроме строковых. При формировании имени используются правила создания идентификаторов Паскаля:

• имя содержит латинские буквы, цифры и знак подчеркивания;

• имя не может начинаться с цифры;

• разница в высоте символов имени игнорируется, т.е. имена MYRES и MyRes считаются синонимами.

Тип ресурса задается одним из зарезервированных слов: STRINGTABLE — для строкового ресурса и RCDATA — для ресурса пользователя. В отличие от имен эти слова, а также зарезервированные слова BEGIN и END, обрамляющие раздел описания ресурса, должны состоять только из заглавных букв.

Раздел описания открывается словом BEGIN и завершается словом END. Каждая строка в строковом ресурсе описывается следующим образом:

<НОМЕР>"[<СТРОКА>]"

<НОМЕР> представляет собой произвольное целое число без знака в диапазоне от 0 до 65535. Это число трактуется как уникальный идентификатор строки и не может быть одинаковым у двух разных строк в пределах всего RC—файла, (в файле может быть сколько угодно описаний


h0228.htm

228______________________________________________________Глава 9

строковых ресурсов). Строка обрамляется двойными кавычками и может быть пустой, т.е. между обрамляющими кавычками может не быть ни одного символа. Если в строку необходимо поместить символ «"», он удваивается. На одной текстовой строке файла можно размещать произвольное количество описаний строк. Перед номером и после него может стоять сколько угодно разделителей — пробелов, символов табуляции и запятых. Если в строке встретилась точка с запятой, остаток строки игнорируется — таким способом можно вставлять комментарии. Внутри обрамляющих кавычек разделители теряют свое специальное назначение и считаются обычными символами. Пример правильного описания строкового ресурса:

STRINGT^BLE BEGIN

1 "Первая строка" 2"Вторая строка"5"Пятая строка" ,,,,,4,,,"Четвертая строка..." END

При выводе строк этого ресурса в цикле от 1 до 5 не экране появится такой текст:

Первая строка Вторая строка Четвертая

строка... Пятая строка

Как видим, разрыв концом строки текста Четвертая строка. . . привел к тому, что вторая часть текста выводится на следующей строке, но с той же позиции, на которой закончился вывод первой части. Это связано с тем, что в строку вставился лишь символ Перевод строки (#10), но не вставился Возврат каретки (#13). Следует заметить, что компилятор ресурсов обрабатывает текст строки по правилам языка Си, в котором разрешены так называемые управляющие символы. Эти символы начинаются обратной косой чертой, за которой может следовать латинская буква, восьмеричное или 16—ричное число в диапазоне О...255. Восьмеричное число состоит из восьмеричных цифр (цифры от 0 до 7), перед 16— ричным числом указывается латинская бука х или X. Комбинация \<ЧИСЛО> определяет внутренний код вставляемого символа, т.е. играет такую же роль, что и константа #<ЧИСЛО> в Паскале. Два следующих управляющих символа вставляют в текст строки символ Возврат каретки (#13):

\15 \xD

Комбинация \<БУКВА> для некоторых букв латинского алфавита определяет часто используемые символы:

Управляющий Значение символ


h0229.htm

Программирование для защищенного режима 229

\а Звуковой сигнал

\Ь Забой слева {Backspace)

\п Перевод строки

\г Возврат каретки

\t Табуляция

Если текст примера отредактировать следующим образом:

4 "Четвертая\п\гстрока" на экран будет выведено:

Четвертая строка

В связи с тем, что символ «\» играет специфичную роль, его нужно удваивать, чтобы компилятор не рассматривал его как служебный символ:

ресурс

4 "Четвертая\\строка" даст на экране

Четвертая\строка

Описание ресурса пользователя в заголовке содержит зарезервированное слово RCDATA, которому должно предшествовать имя ресурса. В раздел описания можно вставлять

• десятичные числа типа Word, Integer,

• шестнадцатеричные числа в диапазоне от $0000 до $FFFF; перед шестнадцатеричным числом ставится символ $;

• цепочки символов в двойных апострофах по правилам строковых ресурсов, но без замыкающего нуля; если требуется поместить в ресурс ASCIIZ— строку, в ее конце нужно добавить «\0»;

• цепочки байтов в одиночных апострофах; байты в такой цепочке

задаются в 16—ричном формате и разделяются пробелами. Пример правильного описания ресурса пользователя:

My Res RCDATA

BEGIN

"Это - АЗС112-строка\О"

$FFFF, 65535 ; две формы записи одного числа

"123456789 А' ; байты со значениями от 1 до 10

-1 127 ; для этих чисел будет выделен® ; по 2 байта

END

Длина каждого ресурса пользователя (а их в одном файле может быть сколько угодно) кратна 256 байтам.

После подготовки текстового файла с описанием ресурсов его следует откомпилировать в КЕБ—файл. Для этого вызывается компилятор BRCC.EXE или компилятор—компоновщик BRC.EXE. Последний не только создает RES—файл, но и пристыковывает его в конец исполняемого файла.


h0230.htm

230______________________________________________________Глава 9

Поскольку компоновщик ВР также умеет работать с ресурсами (для этого введена директива {$R RESFNAME[.RES]}], удобнее использовать компилятор BRCC.EXE. Для его вызова дайте команду ДОС

BRCC MyRes

(предполагается, что путь к католгу размещения файла BRCC.EXE указан в переменной PATH). В результате такого обращения компилятор откомпилирует файл MYRES.RC в файл ресурса MYRES.RES.

9.4.2. Использование ресурсов

Чтобы компоновщик ВР пристыковал ресурсный файл к исполняемой программе, вставьте в ее текст директиву $R, например:

{$R MyRes}

Для получения строки из строкового ресурса используется вызов функции LoadStrng. Следующая программа выведет на экран содержимое строкового ресурса, описанного на с.228:

Uses WinAPI;

{$R MyRes} var

Buf: array [Byte] of Char;

k : Integer;

begin

for k := 1 to 5 do begin

if LoadString(hinstance, k, Buf, SizeOf(Buf))<>0 then

WriteLn(Buf) end;

end.

Доступ к ресурсам пользователя сложнее и выполняется в такой последовательности:

• с помощью FindResource создается дескриптор ресурса;

• если ресурс найден (FindResource возвращет не ноль), он загружается в память обращением к LoadResource, которая возвращает дескриптор выделенного ресурсу блока памяти;

• с помощью LockResource получаем физический адрес блока памяти и работаем с ресурсом;

• после использования ресурса удаляем его из памяти обращением к

FreeResource.

Следующая программа прочитает и распечатает содержимое ресурса, описанного на с.229:

Uses WinAPI;

{$R MyRes! type

PMyRes ^TMyRes;


h0231.htm

TMyRes = record

Text: array [0..19] of Char;

Wordi, Word2: Word;

Bytes: array [1..10] of Byte;

Inti, Int2: Integer-end;

var

P: PMyRes;

ResHandle, MemHandle: Word;

begin

ResHandle :=

FindResource(hinstance, 'MyRes', PChar(Longint(10)));

if HandleoO then begin

MemHandle := LoadResource(hinstance, ResHandle);

P := LockResource(MemHandle);

with P" do begin

WriteLn(Text) ;

WriteLn(Wordi, Word2:10);

for k := 1 to 10 do Write(Bytes[k]:4) ;

WriteLn;

WriteLn(Intl, Int2:10) end;

FreeResource(Handle) end end.

Небольшой комментарий. При обращении к FindResource третьим параметром требуется указать тип ресурса. Этот параметр определен как PChar, но не пытайтесь здесь поместить строку ' RCDATA', т.к. 2 слова этого параметра используются специфичным образом: старшее слово должно содержать 0, а в младшее необходимо поместить числовой идентификатор типа параметра (для ресурса пользователя он равен 10). Именно эту операцию и реализует выражение

PChar(Longint (10))

9.5. СОЗДАНИЕ И ИСПОЛЬЗОВАНИЕ ДИНАМИЧЕСКИХ БИБЛИОТЕК

Динамически подключаемые библиотеки (далее DLL) представляют собой универсальный механизм интегрирования в Вашу программу процедур и функций, написанных другими программистами и, в общем случае, на других, чем Паскаль, языках программирования. DLL не могут использоваться в реальном режиме ДОС и поэтому в Турбо Паскале нет средств работы с ними. В ВР могут создаваться программы для защищенного режима и есть соответствующие средства создания и использования DLL.


h0232.htm

DLL реализуются в виде исполняемых модулей, содержащих готовые к работе процедуры, функции и/или ресурсы. С точки зрения программиста, есть много общего между DLL и обычными для Турбо Паскаля модулями Unit, т.к., в конечном счете, и библиотеки, и модули поставляют подпрограммы, избавляющие программиста от написания собственного кода. Но есть и принципиальные отличия. Главным из них является то, что DLL не в состоянии поставлять в программу переменные, константы и типы, ведь создатели DLL могут использовать нетипизированные языки программирования, например, язык ассемблера. В результате DLL не могут экспортировать в программу столь необходимые сегодня программисту объекты.

Другим важным отличием является способ связывания экспортируемых подпрограмм с основной программой. Модули связываются с программой на этапе компоновки, т.е. статически. Если загружены две программы, использующие одни и те же модули, в памяти будут два экземпляра одинаковых фрагментов кода. В отличие от этого DLL подключаются к программе в момент ее исполнения, т.е. динамически. Если, опять же, две программы используют одну и ту же DLL, в памяти будет лишь один экземпляр разделяемого программами кода.

9.5.1. Создание DLL

Для создания DLL в ВР введено зарезервированное слово Library, которым должен начинаться текст библиотеки. За словом Library следует правильный идентификатор, но в отличие от объявления модуля он не обязан совпадать с именем файла: имя DLL определяется именем DLL-файла, а не идентификатором, следующим за Library.

Структура текста DLL повторяет структуру обычной программы с тем исключением, что раздел исполняемых операторов в DLL играет ту же роль, что и установочная часть модуля: операторы этой части исполняются только один раз в момент загрузки библиотеки в память. Каждое очередное обращение с требованием загрузить библиотеку наращивает на единицу ее счетчик ссылок, но не приводит к выполнению операторов исполняемой части.

Сразу за заголовком экспортируемой подпрограммы должно следовать зарезервированное слово Export, которое заставит компилятор выработать специальный код пролога/эпилога. DLL имеют сегменты кода и данных, но у них нет сегмента стека. Специальный пролог/эпилог позволяет DLL— подпрограмме использовать сегмент стека вызвавшей ее программы.

В разделе описаний DLL могут объявляться типы (в том числе и объекты), константы и переменные, но они остаются скрытыми от вызывающей программы и могут использоваться только внутри DLL. В разделе описаний помимо стандартных для обычной программы объявлений используется специальный раздел объявления экспортируемых подпрограмм. Этот раздел начинается зарезервированным словом Exports, за которым через запятую перечисляются имена экспортируемых подпрограмм, например:

Library MyLibrary;

Function MyFunc(...):...; Export;

begin


h0233.htm

end;

Procedure MyProc; Export;

begin

end;

Exports

MyFunc, MyProc;

begin end.

Раздел Exports помогает компилятору и компоновщику создать специальный заголовок DLL— модуля, в котором перечисляются имена подпрограмм и адреса их точек входа. В DLL может быть несколько списков Exports, но перечисляемые в них подпрограммы должны быть описаны где — то выше по тексту библиотеки.

Помимо имени подпрограммы в заголовок DLL помещается также ее порядковый номер, точнее присвоенный ей целочисленный индекс. Это позволяет вызывающей программе ссылаться не на имя, а на индекс подпрограммы и тем самым уменьшить затраты времени на установление с ней связи. Индекс присваивается подпрограмме по порядку ее появления в списках Exports', первая подпрограмма в первом списке получает индекс 1, следующая — 2 и т.д. Программист может изменить умалчиваемую индексацию и явно указать индекс подпрограммы, добавив за ее именем в списке Exports слово index та. целое число без знака в диапазоне от 1 до 32767:

Expots

MyFunc index 1, MyProc index 2;

Во избежание возможной путаницы с индексацией советую явно задавать индексы всем экспортируемым подпрограммам1.

Программист может определить внешнее имя экспортируемой подпрограммы отличным от ее настоящего имени. Для этого в списке Exports добавляется слово name и внешнее имя в апострофах:

Exports

MyFunc index 1 name 'NEWFUNC';

Обратите внимание: указываемое в апострофах внешнее имя должно состоять из заглавных букв. Если в приведенном выше примере задать ' NewFunc', вызывающая программа не сможет найти функцию MyFunc ни по имени, ни по индексу! По умолчанию ВР создает внешнее имя совпадающим с настоящим, но преобразует его буквы к заглавным.

Вызывающая программа может ссылаться или на имя экспортируемой подпрограммы, или на ее индекс. При вызове по имени программа про—

1 Мною замечено, что ВР начинает умалчиваемую индексацию не с 1, а с 2, что может существенно повлиять на использование DLL. Более того, даже если первой подпрограмме явно присвоить индекс 1, следующая за ней подпрограмма получит умалчивоемый индекс 3, d не 2.


h0234.htm

сматривает имена в таблице имен в поисках нужного. Так как имена могут состоять из длинных наборов символов и самих имен в таблице может быть много, процесс поиска имени существенно медленнее, чем процесс поиска индекса. Поэтому опытные программисты предпочитают ссылаться не на имя, а на индекс подпрограммы. Тем не менее, нельзя исключить возможность того, что программа будет вызывать DLL—подпрограмму по имени^ В этом случае затраты времени на поиск можно заметно сократить, если указать в списке Exports слово resident:

Exports

MyFunc index 1 name 'NEWFUNC' resident;

Информация о подпрограмме, экспортируемой с признаком resident, сохраняется в памяти во все время использования библиотеки.

Замечу, что в отличие от модулей ВР не компилирует DLL автоматически в режимах MAKE или BUILD, т.к. справедливо рассматривает ее как другую программу, никак не связанную в момент компиляции с основной программой.

В заключение рассмотрим реальный пример создания DLL, в котором иллюстрируются различные приемы объявления экспортируемых подпрограмм. Для примера я выбрал модуль Cmplx, описанный в п.9.7. В его состав входят 4 процедуры, реализующие действия с комплексными числами. Вариант соответствующей DLL показан ниже.

{$N+,E+} {Используем сопроцессор для типа Single} Library Complex;

type

TComplex = record Re, Im: Single

end;

Procedure CmplxAdd(x, y: TComplex; var z: TComplex); Export;

begin

z.Irn := x.Im + y.Im;

z . Re : = x. Re + у. Re end;

Procedure CmplxSub(x, y: TComplex; var z: TComplex); Export;

begin

z.Im := x.Im - y.Im;

z. Re : = x. Re - у. Re end;

Procedure CmplxMul(x, y: TComplex; var z: TComplex); Export;

begin

z.Re := x.Re * y.Re + x.Im * y.Im;

z.Im := x.Re * y.Im - x.Im * y.Re end;


h0235.htm

Программирование для защищенного режима 235

Procedure CmplxDiv(x, у: TComplex; var z: TComplex); Export;

var

zz: Single;

begin

zz := sqr(y.Re) + sqr(y.Im);

z.Re := (x.Re * y.Re + x.Im * y.Im)/zz;

z.Im := (x.Re * y.Im - x.Im * y.Re)/zz end;

Exports

CmplxAdd index 1 name 'ADD' resident,

CmplxSub index 2,

CmplxMul index 3,

CmplxDiv index 4;

begin end.

9.5.2. Использование DLL

Для использование подпрограмм из DLL необходимо описать их как внешние, добавив за словом External имя библиотеки в апострофах:

Procedure MyProc; Far; External 'MyDLL';

Обратите внимание: перед External нало обязательно указать Far. в противном случае компилятор потребует поставить точку с запятой после слова External. Как уже говорилось, подпрограмма вызывается по имени или по индексу. В нашем примере из библиотеки MyDLL вызывается подпрограмма с внешним именем 'MYPROC'. Если нужно сослаться на индекс подпрограммы, за именем библиотеки указывается слово index и индекс:

Procedure MyProc; Far; External 'MyDLL' index 2;

В этом случае имя, под которым подпрограмма будет известна программе, может не совпадать с ее внешним DLL— именем. Впрочем, программист может и явно переопределить имя подпрограммы, даже если он ссылается на ее внешнее имя:

Procedure MyProc; Far; External 'MyDLL' Name 'ExtName';

В это варианте предполагается, что экспортируется процедура с внешним именем ' EXTNAME'.

После любого из указанных выше обяъвялений экспортируемая подпрограмма становится доступна программе и может использоваться в ней как обычная подпрограмма на Паскале независимо от того, какой язык программирования использовали ее создатели.

В следующей программе используется библиотека Complex, описанная на предыдущей странице. {$N+,E+} type


h0236.htm

TComplex = record Re, Im: Single

end;

Procedure Add(x, y: TComplex; var z: TComplex); Far;

External 'Complex' ;

Procedure Sub(x, y: TComplex; var z: TComplex); Far;

External 'Complex' index 3;

Procedure Mul(x, y: TComplex; var z: TComplex); Fae;

External 'Complex' Index 4;

Procedure CDiv(x, y: TComplex; var z: TComplex); Far;

External 'Complex' name 'CmplxDiv';

var

a,b,c: TComplex;

begin

{Исходные комплексные числа: 1+li, 1+21}

a. Re := 1;

а. Im : = 1 ;

b.Re := 1;

b.Im := 2;

Add(a,b,с);

WriteLn('Сложение : ', с.Re:3:0, c.Im:4:0,'i');

Sub (a,b,с) ;

WriteLn('Вычитание: ', c.Re:3:0, c.Im:4:0,'i');

Mul (a,b,c) ;

WriteLn('Умножение: ', c.Re:3:0, c.Im:4:0,'i');

CmplxDiv(a,b,с);

WriteLn('Деление : ', c.Re:3:l, c.Im:4:1,'i');

end.

Описанный выше способ связывания DLL с основной программой называется статическим, т.к. он реализуется компилятором и компоновщиком. В результате Windows — заголовок программы для защищенного режима будет содержать список всех DLL и загрузчик расширителя ДОС загрузит библиотеки в память одновременно с загрузкой самой программы.

Программа может загружать DLL и самостоятельно (динамически) с помощью трех функций, входящих в модуль WinAPI: LoadLibrary, CetProcAddress и FreeLibrary. Следующий пример иллюстрирует технику динамической загрузки DLL Complex:

{$N+,E+} Uses WinAPI;

type

TComplex = record Re, Im: Single

end;

TComplexProc = Procedure (x, y: TComplex; var z: TComplex);

var

a, b, c: TComplex;


h0237.htm

Программирование для защищенного режима 237

Add, Sub, Mul, CDiv: TComplexProc;

Handle: Word;

begin

{Исходные комплексные числа: 1+li, 1+2i} a. Re := 1;

a. Im : = 1;

b.Re := 1;

b.Im := 2;

{Загружаем библиотеку COMPLEX.DLL) Handle := LoadLibrary('COMPLEX.DLL');

if Handle = 0 then begin

WriteLn('He найдена библиотека COMPLEX.DLL');

Halt end;

{Определяем адреса процедур. Три первые вызываем по

индексу, четвертую - по имени. При вызове по индексу

младшее слово PChar должно содержать индекс,

поэтому делаем приведение типов:} @Add := GetProcAddress(Handle,PChar(Longint(1)));

@Sub := GetProcAddress(Handle,PChar(Longint(2)));

@Mul := GetProcAddress(Handle,PChar(Longint(3) ));

@CDiv := GetProcAddress(Handle,'CmplxDiv');

{Используем библиотеку} Add(a,b,с) ;

WriteLn('Сложение : ', с.Re:3:0, с.Im:4:0,'i') ;

Sub(a,b,с) ;

WriteLn('Вычитание: ', c.Re:3:0, c.Im:4:0,'i');

Mul(a,b,c) ;

WriteLn('Умножение: ', c.Re:3:0, c.Im:4:0,'i');

CDiv(a,b,c) ;

WriteLn('Деление : ', c.Re:3:1, c.Im:4:1,'i');

{После использования удаляем библиотеку из памяти} FreeLibrary(Handle) end.

При вызове DLL—подпрограмм в большинстве случаев бывает необходимо передавать структурированные параметры типа записей, как тип TComplex в предыдущем примере. Поскольку DLL не могут экспортировать типы, приходится объявлять эти типы в вызывающей программе. Если Вы часто обращаетесь в своих программах к той или иной DLL, удобно создать интерфейсный модуль, содержащий объявления как подпрограмм, так и связанных с ними типов. Например:

Unit Cmplx;

{$N+,E+}

Interface type

TComplex = record


h0238.htm

Re, Im: Single end;

Procedure Add (x, y: TComplex; var z: TComplex);

Procedure Sub (x, y: TComplex; var z: TComplex);

Procedure Mul (x, y: TComplex; var z: TComplex);

Procedure CDiv(x, y: TComplex; var z: TComplex);

Implementation Procedure Add; External 'Complex' index 1;

Procedure Sub; External 'Complex' index 2;

Procedure Mul; External 'Complex' index 3;

Procedure CDiv; External 'Complex' index 4;

end.

Такой интерфейсный модуль существенно упрощает разработку основной программы:

{$N+,E+} Uses Cmplx;

var

a,b,c: TComplex;

begin

a. Re := 1;

a. Im := 1;

b.Re := 1;

b.Im := 2;

Add(a,b,c) ;

WriteLnCСложение : ', с.Re:3:0, с.Im:4:0,'i');

Sub (a,b,c);

WriteLn('Вычитание: ', с.Re:3:0, с.Im:4:0,'i') ;

Mul(a,b,с);

WriteLn('Умножение: ', с.Re:3:0, с.Im:4:0,'i') ;

CDiv(a,b,с) ;

WriteLn('Деление : ', с.Re:3:1, с.Im:4:1,'i') ;

end.


h0239.htm

Глава 10

АДАПТАЦИЯ MS-DOS-ПРОГРАММ К РАБОТЕ В СРЕДЕ WINDOWS

Операционная система Windows получила повсеместное распространение и фактически стала стандартной ОС для ПК, поэтому рано или поздно Вам покажутся тесными рамки MS-DOS и Вы захотите попробовать свои силы в написании программ для Windows. Программирование для Windows существенно отличается от программирования для ДОС и его невозможно сколько-нибудь подробно рассмотреть в рамках этой книги. В этом разделе приводятся лишь минимальные сведения о том, как с помощью ВР создать программу, которая бы успешно запускалась из Windows и использовала бы некоторые возможности этой ОС.

10.1. ВВЕДЕНИЕ В WINDOWS

С позиций программиста Windows представляет собой набор системных функций, образующий так называемый API — интерфейс прикладных программ (API — Application Programming Interface}. Чтобы выполнить то или иное действие (например, открыть окно или начертить линию), программа обращается к соответствующей функции API. Функции API образуют ядро Windows.

В состав ядра входит более 800 функций, которые хранятся в многочисленных динамических библиотеках Windows. Наиболее важные из них сосредоточены в трех файлах: KERNEL.EXE (kernel — ядро), USER.EXE (user — пользователь) и GDI.EXE (Graphics Device Interface — интерфейс графических устройств). Библиотека KERNEL.EXE (на самом деле в зависимости от типа процессора используется KRNL286.EXE или KRNL386.EXE] содержит функции управления памятью, загрузки/удаления программ и обеспечивает непосредственную пода.ержку выполнения программ. Б USER.EXE сосредоточены функции управления окнами (создание окна, изменение его размеров, перемещение, удаление), другими элементами интерфейса, а также функции ввода с клавиатуры и работы с мышью. Наконец GDI.EXE обеспечивает взаимодействие с графическими устройствами (в том числе с экраном, принтерами и плоттерами).

Любая Windows— программа владеет хотя бы одним окном, чаще всего представленным в виде прямоугольной области экрана (в отличие от окон модуля CRT Турбо Паскаля окна Windows могут быть невидимыми). С каждым окном связана некоторая функция, которая называется оконной функцией. В противоположность API—функциям, служащим для связи программы с Windows, оконная функция выполняет обратную задачу и используется для передачи сообщений от Windows к программе. Этой функции Windows посылает сообщения — небольшие информационные пакеты данных. Сообщения возникают как реакция Windows на те или иные события — действия пользователя с клавиатурой или мышью, события от таймера, сигналы от внешних устройств и т.п. И хотя одновре—


h0240.htm

менно под управлением Windows могут выполняться несколько программ и, следовательно, существует целый набор окон, Windows безошибочно распознает тип события и направляет сообщение о нем нужной оконной функции.

В момент загрузки программа создает так называемое главное окно, которое служит своеобразным «пропуском» в мир Windows: целочисленный идентификатор окна — дескриптор — используется как параметр обращения к большинству API— функций и, следовательно, не создав окна, программа не сможет воспользоваться возможностями Windows. Для создания окна программа должна подготовить и указать Windows оконную функцию. Если окно создано правильно, Windows возвращает программе дескриптор окна и создает очередь сообщений, которые будут передаваться в оконную функцию. Первоначально очередь пуста, но как только пользователь начнет работать с программой, эта очередь будет заполняться сообщениями Windows о действиях пользователя. Если пользователь закрывает главное окно, Windows прекращает работу программы и выгружает ее из памяти.

10.2. МОДУЛЬ WINCRT

В состав ВР входит модуль WinCRT, с помощью которого создается полноценное Windows—окно с собственной оконной функцией. Все действия по созданию окна выполняются в установочной секции модуля и, следовательно, скрыты от программиста. Таким образом, многие MS-DOS—программы можно практически без переделки перенести в среду Windows: для этого достаточно указать ссылку на WinCRT в предложении Uses. Например, следующая программа выводит график и таблицу значений функции у = sin(x):

Program WinCRT_Demo;

Uses WinCRT;

var

k: Integer; {Параметр цикла} const

NX = 50; {Количество точек по горизонтали} dX = 2*pi/NX; {Шаг табуляции} NY = 10; {Амплитуда графика} begin

ScreenSize.X := 80; {Ширина виртуального экрана} ScreenSize.Y := 60; {Длина экрана} AutoTracking := False;{Запрещаем прокрутку} for k := 0 to NX do begin

{Выводим ось абсцисс:}

GotoXY(k+l,NY) ;

Write(' -') ;

{Выводим точки графика:}

GotoXY(k+1,Round(NY*(1+sin(dX*k))));

Write ('*');


h0241.htm

{Формируем таблицу значений:} GotoXY(NX+5,k+l) ;

Write(dX*k:4:2,sin(dX*k):8:2) end;

end.

После ссылки на WinCRT в распоряжение программы предоставляются некоторые из процедур и функций стандартного модуля CRT, рассчитанные на текстовый режим работы. В частности, программа может использовать стандартные процедуры ввода—вывода ReadLn и WriteLn, функции KeyPressed и ReadKey, процедуру GotoXY. Для программы создается специальное окно, размеры и положение которого можно менять. В это окно направляется текстовый вывод программы, причем с помощью стандартных для Windows полос управления по бокам окна можно просмотреть вывод, не умещающийся полностью в пределах окна.

Следует учестьг что кодировка символов кириллицы в Windows отличается от широко используемой альтернативной кодировки ДОС, поэтому, если Ваша программа посылает на экран русскоязычные сообщения, в Windows—окне эти сообщения будет невозможно прочитать. Символы кириллицы в Windows используют последние 64 значения кодов: диапазон от 192 до 223 занимают коды заглавных букв от А до Я (без Ё), а диапазон от 224 до 255 — коды строчных буквы от а до я (без ё). Код буквы Ё — 168, а ё - 184.

Д^я преобразования символов можно использовать такую функцию:

Function OEM_to_ANSI(S: String): String;

var

k: Integer;

begin

for k := 1 to Length(S) do case S[k] of

•A'..'Я': S[k] := chr(ord(S[k])-ord('A')+192) ;

'a'..'!!': S[k] := chr(ord(S[k])-ord('a')+224) ;

•p'..'я': S[k] := chr(ord(S[k])-ord('p')+240) end;

OEM_to_ANSI := S end;

Вставьте в текст предыдущей программы эту функцию, а перед оператором

for k := 0 to NX do добавьте

WriteLn(OEM_to_ANSI('График функции SIN(X)')) ;

чтобы в Windows — окне напечатать заголовок графика.


h0242.htm

?4^_____________________________________________ Глава 10

10.2.1. Переменные модуля WinCRT

WindorfOrg: TPoint

Содержит начало координат виртуального окна. По умолчанию — 0,0.

WindowSize: TPoint

Содержит начальный размер окна.

ScreenSize: TPoint

Содержит размер экрана в символах. Начальное значение:

ScreenSize.X = 80 ScreenSize.Y = 25

Если вывод программы содержит более ScreenSize. У строк, лишние строки будут безвозвратно потеряны, поэтому перед первым выводом на экран следует поместить в это поле подходящее значение (см. пример выше). Точно так же следует настроить ScreenSize,X, если на экран выводятся длинные строки.

Cursor: TPoint

Содержит текущую позицию курсора. Левый верхний угол окна соответствует координатам 0,0. Это поле доступно только для чтения, его значение меняется при обращении к CursorTo или GotoXY.

Origin: TPoint

Содержит координаты левого верхнего угла окна просмотра относительно границ виртуального экрана. Поле доступно только для чтения, его значение меняется при обращении к процедуре ScrolITo.

InactiveTitle: PChar

Содержит указатель на строку символов, использующуюся в качестве заголовка для неактивного окна (т.е. окна после окончания работы программы).

AutoTracking: Boolean

Управляет «прокруткой» содержимого окна: если содержит True, окно автоматически сдвигает свое содержимое при выходе вывода за границы, если False — прокрутка запрещена. В неактивном окне можно использовать управляющие полосы для просмотра вывода даже в том случае, когда AutoTracking = False — окно просмотра меняет свое положение в пределах ScreenSize.

CheckEOF: Boolean

Содержит True, если программа обнаружила конец файла.

CheckBreak: Boolean

Содержит True, если пользователь нажал Ctrl—Break.

WindowTitle: array [0..79] of Char

Содержит заголовок активного окна (т.е. окна в момент работы программы).


h0243.htm

Адаптация MS—DOS—программ к работе в среде Windows 243

10.2.2. Процедуры и функции

Procedure AssignCRT(var F: Text)

Связывает содержимое файловой переменной F с виртуальным экраном.

Procedure CIrEOL

Очищает строку от текущего положения курсора до конца строки.

Procedure CIrScr

Очищает виртуальное окно.

Procedure CursorTo(X,Y: Integer)

Переводит курсор в заданную точку виртуального экрана. Начало отсчета соответствует точке 0,0.

Procedure DoneWinCRT

Уничтожает окно вывода программы. Эта процедура автоматически вызывается при закрытии окна.

Procedure GotoXY(X,Y: Integer)

Переводит курсор в нужную точку окна. Начало отсчета соответствует точке 1,1.

Procedure InitWinCRT

Создает виртуальное окно вывода. Эта процедура автоматически вызывается при первом обращении программы к функциям текстового вывода.

Function KeyPressed: Boolean

Возвращает True, если буфер ввода содержит хотя бы один непрочитанный символ.

Function ReadBuf(Buf: PChar; Count: Word): Word

Читает до Count символов из клавиатуры в память, на которую указывает Buf, и возвращает количество действительно прочитанных символов.

Function ReadKey: Char

Возвращает очередной символ из буфера ввода. Если к моменту обращения буфер пуст, приостанавливает работу программы до нажатия пользователем на любую клавишу и возвращает расширенный код этой клавиши.

Procedure ScrollTo(X,Y: Integer)

Смещает содержимое окна так, чтобы его левый верхний угол соответствовал точке X,Y (начало отсчета 0,0).

Procedure TrackCursor

Смещает содержимое окна такг чтобы в нем стал виден курсор.

Function WhereX: Byte

Возвращает текущую абсциссу курсора (начало отсчета 1,1).


h0244.htm

Function WhereY: Byte

Возвращает текущую ординату курсора (начало отсчета 1,1).

Procedure WriteBuf(Buf: PChar; Count: Word) Выводит в окно Count символов из буфера Buf.

Procedure WriteChar(Ch: Char)

Выводит в текущую позицию окна символ Ch.

10.2.3. Модификация WinCrt для использования графики Windows

Хотя стандартный модуль WinCRT и создает нормальное Windows — окно, воспользоваться дескриптором этого окна и, следовательно, получить с его помощью доступ к графическим возможностям Windows невозможно, т.к. этот параметр «спрятан» в раздел Implementation. Поскольку в поставку ВР входит исходный текст модуля, можно модифицировать этот текст — перенести параметр CrtWindow, хранящий дескриптор окна, в раздел Interface. Следует учесть, что простая перекомпиляция измененного текста модуля не даст желаемого результата, т.к. его rPW—файл1 включен в основную библиотеку System и загружается из нее автоматически при ссылке на модуль WinCRT. Наиболее простым выходом из положения является переименование модуля и ссылка на его измененное имя в основной программе. Например:

Unit Win_Crt;

{$S-} interface uses WinTypes, WinProcs, WinDos;

const

CrtWindow: HWnd 3S 0; {Дескриптор окна}

implementation

• • • • •

end.

Следующая программа создает окно, показанное на рис. 10.1. В этой программе график функции у = sin(x) (см. программу WinCRT_Demo в п. 10.2) строится с использованием графических средств Windows.

Uses Win_CRT, WinProcs, WinTypes, Strings;

var

k:.Integer; {Параметр цикла}

DC: hDC;

R: TRect;

01dFont,Font: hFont;

LogFont: TLogFont;

const

1 В файлах с таким расширением хранятся результаты компиляции модулей, расчитанных на работу под управлением Windows.


h0245.htm

NX = 50; {Количество точек по горизонтали}

dt = 2*pi/NX; {Шаг табуляции}

МахХ = 300; {Горизонтальный размер графика}

MaxY = 100; {Амплитуда графика}

dx = МахХ div NX; {Горизонтальный шаг графика}

dd = 20; {Поле по краям графика}

________________________________________.....- -"•г

r.'jll^n^nn^I^^

Puc.JOJ.

begin

ScreenSize.X := 80; {Ширина виртуального экрана} ScreenSize.Y := 60; {Длина экрана} AutoTracking :== False; {Запрещаем прокрутку} InitWinCrt; {Создаем окно} DC := GetDC(CrtWindow); {Получаем его контекст} {Выводим светлосерый прямоугольник для фона графика} R.Left := 0;

R.Top := 0;

R.Right := MaxX+3*dd;

R.Bottom := 2*MaxY+3*dd;

FillRect(DC,R,GetStockObject(LtGray_Brush)) ;

{Вычерчиваем оси} MoveTo(DC,dd,dd) ;

LineTo(DC,dd,2*(MaxY+dd)) ;

MoveTo(DC,dd,MaxY+dd) ;

LineTo(DC,MaxX+2*dd,MaxY+dd) ;

{Готовим шрифт для надписи} FillChar(LogFont,SizeOf(LogFont) ,0);

with LogFont do


h0246.htm

begin

IfHeight := 20; {Высота букв} If Italic := 1; {Наклоннный шрифт} • IfUnderline :== 1; {Подчеркнутый шрифт} ifWeight := fw Bold; {Жирный шрифт} StrCopy(lfFaceName,'Arial Cyr') {Имя шрифта} end;

Font := CreateFontIndirect(LogPont); {Создаем шрифт} OldFont := SelectObject(DC,Font); {Вставляем его в

контекст окна} . SetBkMode(DC,Transparent); {Отключаем изменение

фона надписи} {Выводим надпись} DrawText(DC,'График синуса',13,R,dt_Center);

SelectObject(DC,OldFont); {Восстанавливаем контекст} DeleteObject(Font); {Уничтожаем шрифт} {Цикл построения графика и вывода таблицы значений} for k := 0 to NX do begin

{Выводим точки графика:} LineTo(DC,k*dx+dd,Round(MaxY*(1-sin(dt*k)))+dd) ;

{Формируем таблицу значений:} GotoXY(NX+5,k+l) ;

Write(dt*k:4:2,sin(dt*k):8:2) end;

ReleaseDC(CrtWindow,DC) {Освобождаем контекст} end.

Сначала несколько пояснений. Обычно Windows—окно создается в момент первого обращения программы к процедуре вывода Write/WriteLn. До этого момента окно не создано и его дескриптор недействителен. Поскольку программа вначале выводит серый фоновый прямоугольник и оси графика, ей понадобится дескриптор окна, поэтому она обращается к процедуре InitWinCrt для «досрочного» создания окна. Далее, графический вывод в Windows реализуется с помощью так называемого контекста графического устройства. Программа обращается к API— функции GetDC, чтобы Windows создала контекст окна. Стандартный контекст включает три чертежных инструмента: кисть, перо и шрифт. Кисть предназначена для закрашивания больших поверхностей, перо — для вычерчивания фигур, а шрифт — для вывода надписей.

Для вывода светлосерого прямоугольника программа обращается к Ар/функции FilIRect, передавая ей три параметра: контекст устройства, размеры прямоугольника и светло-серую кисть. Размеры прямоугольника задаются переменной R в виде координат левого верхнего и правого нижнего углов прямоугольника. Координаты указываются в пикселах экрана и отсчитываются от левого верхнего угла рабочей области окна. Чтобы указать светло-серую кисть, вызывается функция GetStockObject с


h0247.htm

Адаптация MS—DOS—программ к работе в среде Windows 247

параметром LtGray_Bmsh. В стандартный контекст входят также черная, белая и темно — серая кисти.

Вывод осей графика и самого графика осуществляется с помощью пера и двух АРУ—функций: MoveTo и LineTo. Первая перемещает перо в заданное положение на контексте устройства, вторая вычерчивает линию от текущего положения пера к указанной точке и оставляет перо в этой точ — ке. Стандартный контекст оснащен пером, вычерчивающим черные линии толщиной в 1 пиксел. Если бы программе понадобилось другое перо, она должна была бы предварительно его создать и включить в контекст, а после использования — удалить его из контекста и уничтожить.

Именно такие действия осуществляются при выводе заголовка графика. Сначала создается новый шрифт (стандартный шрифт контекста практически не отличается от обычного системного шрифта). Для этого переменная LogFont, содержащая описание шрифта, вначале заполняется нулями, после чего в нее помещаются признаки утолщенного, наклонного и подчеркнутого шрифта, его высота и имя. Описав нужный шрифт, программа обращается к функции CreateFontIndirect, чтобы Windows по этому описанию создала шрифт и вернула его дескриптор, который запоминается в переменной Font. После этого обращением к SeIectObject в контекст окна вместо стандартного шрифта вставляется новый, причем дескриптор старого шрифта запоминается в переменной OldFont. Теперь все готово для вывода надписи. После обращения к SetBkMode (этот вызов необходим для отключения прорисовки фона букв) вызывается функция DrawText, которой передается подготовленный контекст, текст надписи, длина текста, охватывающий прямоугольник (переменная R) и признак центрирования надписи по горизонтали. По завершению вывода в контекст вставляется стандартный инструмент, а ненужный более шрифт уничтожается.

После циклического формирования графика и таблицы контекст окна также уничтожается с помощью обращения к функции ReleaseDC.

Полученный таким способом график крайне недолговечен: стоит изменить размеры окна или сделать его прокрутку, как он тут же бесследно исчезнет. Осуществив более глубокую модификацию модуля WinCRT, графику можно придать необходимую «прочность». Я мог бы описать необходимые изменения, но... может быть лучше заняться серьезным изучением Windows?


h0248.htm

ПРИЛОЖЕНИЕ

ТЕКСТЫ ПРОГРАММ П1. МОДУЛЬ ПОДДЕРЖКИ ТЕКСТОВОГО ВЫВОДА F_TEXT

Этот модуль не описан в книге, т.к. мне показалось, что реализуемая в нем техника мно— гостраничног'--- текстового ввода/вывода не представляет интереса для широкого круга читателей. Тем не менее его полный текст приводится ниже, т.к. некоторые тестовые программы и модули использует его для создания текстовых окон.

^«""~~"==-====; Unit F_Text; {==«=====.,===„} {+~ --———------————------—--—————————-------- --"-./-

I В этот модуль входят подпрограммы поддержки ¦

I многостраничного вывода а текстовом режиме ¦

+——————— ———_—_——____--__————_—_-__+;

INTERFACE {—— ——————.—— _——_-__——_——_——_._————__,

Oses CRT, DOS;

{Следующие константа используются для указания типа рамки при обращении к процедурам BORDER, SETWINDO» и PUTWINDOW.} const

EmptyBorder =0; {Стереть рамку} SingleBorder =1; {Рачка из одинарных линий} DoubleBorder =2; (Рамка из двойных линий}

{Следующий массив определяет символы псевдографики для вычерчивания рамок (альтернативная кодировка)} BorderChar: array [0..2,1..6] of Char = ((#32, #32, #32, #32, *32, #32), (#218, #196, #191, #179, #192, #217), 1*201, #205, #187, #186, #200, #188));

type

PageType = record {Описатель страницы}

case Byte of

0:(Attrib Byte; {Атрибут символов}

CLineUp Byte; {Верхняя строка курсора} CLineDown Byte; {Нижняя строка курсора} CVisible Boolean; (Признак видимого курсора} WBondUp Word; {Левый верхний угол окна} WBondDown Word); {Правый нижний угол} 1:(РадеРаг: array [1..8] of Byte) end;

const

Pages: array [O..7] of PageType -

((PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)));

{Адрес регистра статуса адаптера CGAf PortCGA = $3DA;

(Начало видеопамяти для CGA/EGA/VGA) BegVideo = $В800;

(Следующие константы зависят от режима работы и типа адаптера. Значения по умолчанию соответствуют CGA/EGA/VGA в режиме С080. Эти значения можно переопределить с помощью процедуры InitText}


h0249.htm

const

MaxPage : Byte =3; {Максимальный номер страницы) MaxChar : Byte = 80; (Количество символов в строке} MaxLine : Byte = 25; (Количество строк на экране} PageSize: Word = 4000; {Размер видимой страницы) VSize : Word = 4096; {Полный размер страницы} VMemory : Word = BegVideo; {Адрес видеопамяти} VMW: array [O..15] of Word =

($0000,BegVideo,$1000,BegVideo,$2000,BegVideo, $3000,BegVideo,$4000,BegVideo,$5000,BegVideo, $6000,BegVideo,$7 О О 0,BegVideo) ;

{Массив VMP содержит адреса всех видеостраниц. Значения по умолчанию соответствуют адаптерам CGA/EGA/VGA в режиме С080. Эти значения можно переопределить с помощью процедуры InitText) •wax

VMP: array [O..7] of Pointer absolute VMW;

/

I Подпрограммы управления цветом

}

procedure ChangeAttribute(Page,Xl,Yl,X2,Y2,01dAtt,NewAtt: Byte);

{Меняет атрибут OLDATT на значение NEWATT в прямоугольнике XI...Y2 страницы PAGE}

Procedure Colors(Text,Back: Byte);

{Устанавливает цвет текста TEXT и фона BACK в текущей странице}

Procedure PageColors (Page,Text,Back: Byte);

{Устанавливает цвет текста TEXT и фона BACK в странице PAGE}

Function PackAttribute(Text,Back: Byte): Byte;

{Упаковывает два цвета в байт атрибута}

procedure SetAttribute(Page,XI,Y1,X2,Y2,Attr: Byte);

{Заменяет атрибут всех символов в прямоугольнике XI...Y2 страницы PAGE на значение Attr}

Procedure OnPackAttribute(Attr: Byte; var Text,Back: Byte);

{Распаковывает байт атрибута и возвращает два цвета} {

Подпрограммы управления курсором

> Procedure CursorOff;

{Отключает курсор в активной странице}

Procedure CursorOn;

(Включает курсор в активной странице}

Procedure CursorOnOff (Page: Byte; Vis: Boolean);

{Устанавливает признак видимости курсора: PAGE - номер страницы;

VIS - признак видимости}

procedure GetCursor (Page: Byte; var X, .г. Up, Down: Byte);

{Возвращает координаты курсора: PAGE - номер страницы; X,Y - возвращаемые координаты (отсчет от 1,1); Up, Down - размер курсора в строках развертки)

Function GetCursorVisible(Page: Byte): Boolean;


h0250.htm

/Возвращает признак видимости курсора}

Procedure PutCursor(Page,X,Y: Byte);

{Устанавливает требуемое положение курсора. PAGE - номер страницы/ Х,У - координаты курсора (отсчет от 1,1)}

Procedure SetCursorLine(Page,Up,Down: Byte);

{Устанавливает размер курсора/

Подпрограммы управления текстовым выводом \

} Procedure Border (Page,Xl,Yl,X2,Y2,Bord: Byte);

{Обводит рамкой заданную прямоугольную область страницы PAGE: X1..Y2 - координаты окна; BORD - константа 0..2, указывающая тип рамки. Символы рамки выводятся с текущими атрибутами}

Procedure CopyChar (Page: Byte; Cr: Char; Attr: Byte; Count: Word);

{Записывает несколько копий символа, начиная с позиции, на которую указывает курсор: PAGE - номер 0..MaxPage страницы; CR - копируемый символ;

ATTR - его атрибуты; COUNT - количество копий символа. Символ записывается с указанными атрибутами, курсор не меняет своего положения)

Procedure GetChar (Page: Byte; var Cr: Char; var Attr: Byte);

(Читает символ и его атрибуты: PAGE - номер 0..ManPage страницы, откуда нужно прочитать символ; CR - прочитанный символ; ATTR - его атрибуты}

Procedure InitText;

{Переопределяет константы, зависящие от адаптера и режима его работы. Содержимое экрана не меняется}

Procedure MoveFromScreen (var Source, Destin; Count: Word);

{Читает данные из видеопамяти: SOURCE - адрес считываемой видеопамяти;

DESTIN - имя переменной, куда будут прочитаны данные;

COUNT - объем считываемой информации в байтах}

Procedure MoveToScreen (var Source, Destin; Count: Word);

{Записывает данные в видеопамять: SOURCE - переменная, содержащая записываемую информацию; DESTIN - адрес фрагмента видеопамяти; COUNT - объем записываемой информации}

Procedure PageWriteOn;

{Переназначает стандартный канал вывода на процедуру PAGEWRITE, поддерживающую вывод в любую страницу}

Procedure PageWriteOff;

{Восстанавливает стандартный канал вывода}

Procedure PutChar (Page: Byte; Cr: Char);

{Записывает символ на место, указываемое курсором: PAGE - номер 0..MaxPage страницы; CR - записываемый символ; Символ записывается с текущими атрибутами, курсор не меняет своего положения}

Procedure WriteChar (Page: Byte; Cr: Char);

{Выводит символ и сдвигает курсор. Используются текущие атрибуты} г ;(•________________—_*-____^__—.._«—-——--.•.--——•——*

¦Многостраничные варианты подпрограмм модуля CRT\ *_—————---—-——-—---——————————----*;

Procedure CIrEOL;


h0251.htm

{Удаляет остаток строки справа от курсора в активной странице}

Procedure CIrScr;

{Очищает текущее окно (страницу)}

Procedure DelLine;

{Удаляет строку в активной странице}

Procedure GotoXY(X,Y: Byte);

{Устанавливает курсор в активной странице}

Procedure InsLine;

{Вставляет пустую строку в активной странице}

Procedure TextBackGround(Color: Byte);

{Устанавливает цвет фона а активной странице}

Procedure TextColor(Color: Byte);

(Устанавливает цвет символов в активной странице}

Function WhereX: Byte;

/'Возвращает- горизонтальную координату курсора в активной странице}

Function WhereY: Byte;

{Возвращает вертикальную координату курсора в активной странице}

Procedure Window(XI,Y1,X2,Y2: Byte);

{Устанавливает окно в активной странице} _'*_________________—--_____-„_-____-_--__------*

I Подпрограммы управления страницами \ *——————————————_-_-.——__——————————^

Function GetActivePage: Byte;

{Возвращает номер активной текстовой страницы}

Procedure GetPage (Page: Byte; var Destin);

{Копирует текстовую страницу в оперативную память: PAGE - номер копируемой страницы; DESTIN - переменная, куда будет копироваться страница}

Procedure SwapPage (Source, Destin: Byte);

{Копирует одну текстовую страницу в другую: SOURCE - номер страницы-источника информации; DESTIN - номер страницы-приемника}

Function PageSaveSize: Word;

{Возвращает размер буфера, необходимый для сохранения текущего состояния видеостраницы}

Procedure PutPage (var Source; Page: Byte);

{Пересылает копию текстовой страницы из оперативной памяти в видеопамять:

SOURCE - имя переменной, хранящей копию страницы;

PAGE - номер страницы-приемника информации}

Procedure RestorePage(Page: Byte; var Buf);

{Восстанавливает текущее состояние страницы PAGE по содержимому буфера BUF}

Procedure SetActivePage(Page: Byte);

{Устанавливает активной, заданную текстовую страницу. PAGE - номер страницы}

Procedure SavePage(Page: Byte; var Buf);


h0252.htm

252________________________________________________Приложение

(Сохраняет текущее состояние страницы PAGE в буфере BOF} ^——————————————————————————————»

I Подпрограммы управления окнами I *—————————————.————————————————*;

Procedure ChangeWindAttribute(Page,01dAtt,NewAtt: Byte);

{Заменяет в окне PAGE атрибут OLDATT на значение МЕИАТТ}

Procedure CopyWind(Page,X,Y: Byte; var Buf; LX,LY: Byte);

(Переносит копию окна из памяти на страницу}

Procedure GetWindow (Pac-e: Byte);

(Восстанавливает состояние экрана, бывшее перед обращением к процедуре PUTWINDOff: PAGE - номер страницы, куда была скопирована активная}

Procedure PutWindow(Xl,Yl,X2,Y2,Text,Back,Bord,Page: Byte;

Header: String;Clip,Build,Play: Boolean);

(Сохраняет активную страницу в заданной текстовой странице, создает в активной странице окно с заданными атрибутами, очищает его и обводит рамкой:

XI...Y2 - координаты окна; TEXT - цвет символов; BACK - цвет фона;

BORD - константа, указывающая тип рамки; PAGE - номер 0. .Ma.xPa.ge страницы, куда будет скопирована активная страница; HEADER - заголовок окна;

CLIP - признак границ (TRUE - исключая XI...Y2, FALSE - включая границы XI...Y2); BUILD- признак развертывания окна; PLAY - надо ли сопровождать звуком}

Procedure SaveWind(Page: Byte; var Buf; var LX,LY: Byte);

(Сохраняет копию окна в буфере BUF}

Procedure SetPageWindow (Page,XI,Y1,X2,Y2,Bord: Byte;

Header: String; Clip: Boolean);

(Создает окно в странице PAGE и обводит его рамкой: PAGE - номер страницы;

XI...Y2 - координаты окна; BORD - константа, указывающая тип рамки;

HEADER - заголовок окна; CLIP - признак границ (TRUE - внутри XI...Y2, FALSE - включая границы XI...Y2). Символы рамки выводятся с текущими атрибутами, окно очищается}

Procedure SetWindAttribute(Page,Attr: Byte);

(Устанавливает новый атрибут окна}

Procedure SetWindow (Xl,Yl,X2,Y2,Bord: Byte; Header: String; Clip,Build,Play:

Boolean);

{Создает окно в активной странице и обводит его рамкой: XI...Y2 - координаты окна; BORD - константа, указывающая тип рамки; HEADER - заголовок окна;

CLIP - признак границ (TRUE - внутри XI...Y2, FALSE - включая границы XI...Y2); BUILD- признак развертывания окна; PLAY - надо ли сопровождать звуком. Символы рамки выводятся с текущими атрибутами, окно очищается}

Procedure WindMoveTo(Page,X,Y: Byte; var Buf; ClipW: Boolean);

(Перемещает окно в новое положение: PAGE - номер страницы; X,Y - новые координаты левого верхнего угла; BUF - вид экрана без окна; CLIPW- признак отсечки изображения}

Procedure WindMoveRel(Page: Byte; DX,DY: Integer; var Buf; ClipW: Boolean);

(Смещает окно относительно прежнего положения: PAGE - номер страницы;

DX,DY- приращения координат левого верхнего угла; BUF - вид экрана без окна;

CLIPW- признак отсечки изображения/

Function WindSize(Page: Byte): Word;

(Возвращает размер буфера для сохранения окна}


h0253.htm

/—————————————_———;

IMPLEMENTATION ^—————————————————..-————————————-/

var

Reg: registers;

const

ActivePage: Byte =0; (Номер активной страницы} {

Подпрограммы управления цветом

}

Procedure ChangeAttribute(Page,Xl,Yl,X2,Y2,01dAtt,NewAtt: Byte) ;

{Меняет атрибут OLDATT на значение NEHATT в прямоугольнике XI...У2 страницы PAGE} var

Buf: array [1..80,1..2] of Byte;

k,j,Size: Byte;

begin

{Проверяем параметры обращения} if (Page<=MaxPage) and (XI in [1..MaxChar])

and (Yl in [1..MaxLine]) and (X2 in [1..MaxChar]) and (Y2 in [1..MaxLine]) and (X2>Xl) and (Y2>Y1) then begin

Size := (X2-X1+1)*2; {Размер строки видеобуфера} for k := Yl •to Y2 do {цикл по строкам} begin

(Получаем копию видеопамяти} MoveFromScreen(Mem[VMemory:Page*VSi2e+ (pred(k)*MaxChar+Xl-l)*2],Buf,Size) ;

{Меняем атрибут}

for j := 1 to Size div 2 do if Buf[j,2] ° OldAtt then Buf[j,2] := NewAtt;

{Возвращаем в видеопамять} MoveToScreen(Buf,Mem[VMemory:Page*VSize+

(pred(k)*MaxChar+Xl-l)*2],Size) end end

end; (ChangeAttniluce' ;———————————————;

Procedure Colors (Text,Back: Byte);

{Устанавливает цвет текста TEXT и цвет фона BACK для активной страницы} begin

PageColors(ActivePage,Text,Back) end;

^———————————————.^

Procedure PageColors (Page,Text,Back: Byte);

(Устанавливает цвет текста TEXT и цвет фона BACK для страницы PAGE) begin

if Page<=MaxPage then begin

PagesiPage].Attrib := (Text and $8F) or ((Back and ^7) shi 4) or (Back and $80);

if Page=0 then begin

CRT.TextColor(Text);

CRT.TextBackGround(Back) end


h0254.htm

end

end {Colors};

;•————————— ——————^

Procedure SetAttribute(Page,X1,Y1,X2,Y2,Attr: Byte);

{Заменяет атрибут всех символов в прямоугольнике XI...Y2 страницы PAGE на значение Attr} var

Buf: array [1..80,1..2] of Byte;

k,j,Size: Byte;

begin

{Проверяем параметры обращения) if (Page<=MaxPage) and (Xl in [1..MaxChar])

and (Yl in [1..MaxLine]) and (X2 in [1..MaxChar]) and (Y2 in [1..MaxLine]) and (X2>X1) and (Y2>Y1) then begin

Size := (X2-X1+1)*2;

for It := Yl to Y2 do begin

MoveFromScreen(Mem[VMemory:Page*VSize+ (pred(k)*MaxChar+Xl-l)*2],Buf,Size) ;

for j := 1 to Size div 2 do Buf[j,2] := Attr;

MoveToScreen(Buf,Mem[VMemory:Page*VSize+

(pred(k)*MaxChar+Xl-l)*2],Size) end end end; {SetAttribute} _—————————————;

Function PackAttribute(Text,Back: Byte): Byte;

{Упаковывает два цвета в байт атрибута} begin

PackAttribute := (Text and $8F) or

((Back and 7) shi 4) or (Back and $80) end; {PackAttnnute} ^—————————————;

Procedure UnPackAttribute(Attr: Byte; var Text,Back: Byte);

{Распаковывает байт атрибута и возвращает два цвета} begin

Text := Attr and $8F;

Back := (Attr shr 4) and 7 end; {UnPackAttribute) /*_—____—_——^__-«—_———_---—-———-——-----—_------_*

1 Подпрограммы управления курсором 1

Procedure CursorOff;

{Отключает курсор в активной странице} begin

with Reg do begin

AH := 1; {Управление курсором} СН := $20 {Убрать курсор} end;

lntr($10,Reg);

Pages[ActivePage].CVisible := False enu {CursorOff};

/———————————————;

Procedure CursorON;

{Включает курсор в активной странице} begin


h0255.htm

Тексты программ 25S

with Reg,Pages[ActirePage] do begin

AH := 1; {Управление курсором} СН := CLineUp; {Верхняя строка развертки} CL := CLineDown {Нижняя строка} end;

Intr($10,Reg) ;

Pages[ActivePage].CVisible := True end {CursorOn/ ;

^—————————————————_.

Procedure CursorOnOff(Page: Byte; Vis: Boolean);

{Устанавливает признак видимости курсора} begin

if Page<=MaxPage then if Page-ActivePage then case Vis of

True : Cursor-Off;

False: CursorOn end else

Pages[Page].CVisible := Vis end; (CursorOnOff} /————————„——————;

Procedure GetCursor (Page: Byte; var X,Y,Up,Down: Byte);

/'Возвращает координаты и размер курсора:

PAGE - номер страницы;

X, Y - координаты (отсчет от 1,1);

Up, Down - размер курсора} begin

if Page<=MaxPage then with Reg,Pages[Page] do begin

AH := 3; {Получаем положение курсора) ВН := Page; {Номер страницы} Intr($10,Reg) ;

Х := succ(DL); {Преобразуем координаты} Y := succ(DH); {к началу в 1,1} Up := CLineUp; (Верхняя строка развертки} Down := CLineDown (Нижняя строка} end end {GetCursor};

^———————————————;

Function GetCursorVisible (Page: Byte): Boolean;

{Возвращает признак видимости курсора} begin

GetCursorVisible := Pages[Page].CVisible end; (GetCursorVisible} ^———————————————;

Procedure PutCursor(Page,X,Y: Byte);

(Устанавливает требуемое положение курсора. PAGE - номер страницы;

X, Y - координаты курсора (отсчет от 1,1)} begin

{Проверяем параметры обращения} if (Page<=MaxPage)

and (X in [1..MaxChar])

and (Y in [1..MaxLine]) then wxth Reg do begin

AH := 2; {Установить курсор}

DH := pred(Y); {Преобразуем координаты}

DL := pred(X); {к началу в 0,0}


h0256.htm

ВН := Page; {Страница} Intr($10,Reg) end end {PutCursor};

^———————————————-;

Procedure SetCursorLine (Pi-.ge,Up, Down: Byte);

{Устанавливает размер курсора} begin

if Page in [O..MaxPage] then with Pages[Page] do begin

CLineUp := Up;

CLineDown := Down;

if Page=ActivePage then

SetActivePage(Page) end

end; {SetCursorLine) /*_--_--•-______-__•-_-•-_•---•----.--———---«----*

] Подпрограммы управления текстовый выводом ¦ *——————————————————————————————*;

var

OldOutput: Text; (Сохраняет стандартный канал вывода} const

ChangeOut: Boolean = False; {Флаг замены канала вывода)

Procedure WriteCharXY(Page,X,Y: Byte; Cr: Char);

(Выводит символ на указанное место. Атрибуты берутся из пассива Attrib. Курсор остается на месте} var

Loc: Word; {Старое положение курсора} begin

Loc := MemW[$0040:$0050+P?ge];

with Reg do begin

AH := 2;

DL := X-1;

DH := У-1;

BH := Page;

Intr($10,Reg); {Переводим курсор} АН := $9;

AL :° ord(Cr) ;

BL := Pages[Page].Attrib;

BH := Page;

CX := 1;

Intr($lO,Reg); (Выводим, символ} АН := 2;

DX := Loc;

BH := Page;

Intr($10,Reg) {Курсор - на старое место} end;

MemW[$0040:$005O+Page] := Loc end; {WriteChavXYf /—————————————————;

Function ZeroFunc(var F: TextRec): Integer; Far;

{Пустая процедура для операций OPEN/CLOSE} begin

ZeroFunc := 0 end; {ZeroFunc} (———...———— ————————;

Procedure Border (Page,Xl,Yl,X2,Y2,Bord: Byte);

{Обводит ранкой заданную прямоугольную область экрана/


h0257.htm

var

i : Integer;

begin

{Проверяем параметры обращения) if not ((Page>MaxPage) or (X1<1) or (X2<=X1) or (Y1<1) or (Y2<-Y1) or (X2>MaxChar) or (Y2>MaxLine) or (Bord>2)) then begin

WnteCharXY(Page,Xl,Yl,BorderChar[Bord,l]) ;

for i := 1 to X2-X1-1 do {Верхняя рамка} WriteCharXY(Page,Xl+i,Yl,BorderChar[Bord,2]);

WnteCharXY(Page,X2,yi,BorderChar[Bord,3]) ;

for i := 1 to Y2-Y1-1 do {Боковые стороны} begin

WriteCharXY(Page,Xl,Yl+i,BorderChar[Bord,4]) ;

WriteCharXY(Page,X2,Yl+i,BorderChar[Bord,4]) end;

WnteCharXY(Page,Xl,Y2,BorderChar[Bord,5]);

for i := 1 to x2-xl-l do {Нижняя рамка} WriteCharXY(Page,Xl+i,Y2,BorderChar[Bord,2]) ;

WriteCharXY(Page,X2,Y2,BorderChar[Bord,6]) end end {Border};

{— —.—————-.————————;

Procedure CopyChar(Page:Byte; Cr:Char;Attr:Byte; Count:Word);

{Выводит несколько копий символа} begin

if (Count>0) and (Page<=MaxPage) then with Reg do begin

AH :== 9; (Вывод символа} AL := ord(Cr); {Код символа} BL := Attr; {Атрибут} BH := Page; {Страница} СХ := Count; (Количество копий} Intr($lO,Reg) end end /CopyChar};

^—————————————————J

Procedure GetChar (Page: Byte; var Cr: Char; var Attr; Byte);

{Читает символ, на который указывает курсор, и его атрибуты) begin

if Page<=MaxPage then with Reg do begin

AH := 8; {Читать символ) ' BH := Page; {Страница) Intr($10,Reg) ;

Cr := chr(AL); {Символ} Attr := АН {Его атрибут) end

else {Неверная страница) begin

Cr :» chr(O);

Attr := 0 end end {GetChar);

Procedure InitText;

{Переопределяет константы, зависящие or адаптера и режима его работы. Содержимое экрана не меняется)


h0258.htm

var

k: Byte;

Size: Word;

Page: Byte;

begin

{Определяем тип адаптера по байту оборудования ДОС} case (MemW[$0040:$0010] and $30) shr 4 of 3: begin {MDA} MaxPage := 0;

VMemory := $BOOO end;

else begin {Остальные адаптеры} MaxPage :=• 3;

VMemory := $B8OO end;

end;

{Определяем режим работы адаптера} case Mem[$0040:$0049] of

0,1: MaxChar := 40; {40х25} 2,3: MaxChar := 80; {80х25} 1 : begin (MDA) MaxChar := 80;

VMemory := $ВООО end;

else

MaxChar := 80 end;

{Вычисляем остальные константы} MaxLine := 25;

PageSize := MaxLine*MaxChar*2;

Page := ActivePage;

for k := 0 to 7 do begin

SetActivePage(k) ;

VMW[2*k] :« MemW[$OO4O:$004E] end;

VSize := VMH[2]-VMW[O] ;

SetActivePage(Page) end; {InitText} /————————————.-————/

Procedure MoveFromScreen (var Source,Destin;Count: Word);

{Читает данные из видеопамяти} begin

if Count>0 then if not CheckSnow then

Move(Source,Destin,Count) else

{Синхронизация переноса для адаптера CGA} asm

Ids si,[Source] {DS:SI » адрес источника) les di,[Destin] {ES:DI = адрес приемника} mov ex,Count {Загружаем счетчик в СХ} eld (Направление передачи} shr cx,l (Заменяем байты на слова} mov dx,PortCGA /Загружаем а ОХадрес CGA-порта}

( Отсюда начинается цикл чтения из видеопамяти, который продолжается во время обратного хода луча при горизонтальной развертке. } @1: di {Закрываем прерывания} @2: in al,dx {В начале очередного цикла}


h0259.htm

test al,l {проверяем наличие обратного хода}

jne @2 (Ждем обратный ход}

lodsw (Получаем видеослово}

sti (Открываем прерывания}

stosw (Пишем видеослово в приемник}

loop 81 {Продолжаем цикл} end

end; {MoveFromScreen} {,-. —————————— ————;

Procedure MoveToScreen (var Source, Destin;Count: Word);

{Записывает данные в видеопамять} begin

if Count>0 then if not CheckSnow then

Move (Source,Destin,Count) else

{Синхронизация переноса для адаптера CGA} asm

Ids si,[Source] {DS:SI = адрес источника} les di,[Destin] {ES:DI = адрес приемник} mov ex,Count {Грузим в CX счетчик} eld (Направление передачи} shr ex, 1 {Переводим байты в слова) mov dx,PortCGA {Получаем в ОХстатус CGA-порта} mov Ы,9 {Готовим a BL маску проверки готовности} {Отсюда начинается цикл записи в видеопамять, который продолжается во время обратного хода луча при горизонтальной развертке. Запись проходит при закрытых прерываниях.} @3: lodsw {Получаем в ВР}

mov Ьр,ах (очередное видеослово} cli /Закрываем прерывания) @4: in al,dx (Получаем статус видеопорта} test al,l {Конец горизонтального хода?} jne @4 {Нет - ждем} mov ax,bp (Переносим в АХ видеослово} stosw (Пишем его в видеопамять) sti (Открываем прерывания} loop @3 {Продолжаем цикл} end end; {MoveToScreen} _•__—————————————;

Function pagewrite(var F: TextRec): Integer; Far;

{Осуществляет вывод строки, подготовленной процедурами HRITE/WRITELN, в активную видеостраницу} var

k: Integer;

begin

with F,Pages[ActivePage] do if (Mode=fm0utput) and (BufPos>0) then begin

for k := 0 to BufPos-1 do with Reg do WriteChar(ActivePage,BufPtr'^ [k]) ;

BufPos := 0 {Обнуляем буфер.вывода} end;

PageWrite :° О end; (PageWrite} /————————————————;

Procedure PageWriteOff;

(Восстанавливает стандартный канал вывода} begin


h0260.htm

it ChangeOut then begin

move(OldOutput,Output,SizeOf(Output)); , ChangeOut :° False end end; {PagefirlteOff} ^——————_——_——————;

Procedure PageWriteOn;

(Переназначает стандартный канал выведана процедуру PAGEWRITE, поддерживающую вывод в любую страницу} begin

if ChangeOut then

Exit; (Блокируем повторную установку} ChangeOut := True;

(Сохраняем старый драйвер:} move(Output,OldOutput,SizeOf(Output) ) ;

with TextRec(Output) do

begin (Назначаем новый драйвер:} OpenFunc := @ZeroFunc;

InOutFunc := @PageWrite;

FluahFunc := BPageWrite;

CloseFunc := @ZeroFunc;

end end; {PageWriteOn} _•—————_——_-———————;

procedure PutChar (Page: Byte; Cr: Char);

(Записывает символ на место, указываемое курсором в заданной странице. Курсор не меняет положения. Атрибуты берутся из массива Attrib} begin

if Page<°MaxPage then with Reg do begin

AH := $9;

AL := ord(Cr) ;

BH := Page;

BL := Pages[Page].Attrib;

CX := 1;

Intr($10,Reg) end end (PutChar};

^————————_————————;

Procedure WriteChar (Page: Byte; Cr: Char);

{Выводит символ и сдвигает курсор. Используются атрибуты из массива Attrib} var

X,Y,Xl,Yl,X2,Y2,Size: Byte;

Buf: array [1..80,1..2] of Char;

VW,k: Word;

P: Pointer;

begin

if Page<=MaxPage then with Reg,Pages[Page] do begin

GetCursor(Page,X,Y,Xl,Yl) ;

{Смещение в странице} k := (Pred(Y)*MaxChar+Pred(X))*2;

P := ptr(VMemory,VMW[Page*2]+k) ;

VW := Pages[Page].Attrib shi 8+ord(Cr);

case Cr of (Обрабатываем спецсимволы} #7: begin /Звук/ Sound(900) ;

Delay(150);


h0261.htm

NoSound;

Exit end;

#8: if X>Lo(WBondOp)+2 then (Back Space}

dec(X,2)

else if Y>Hi(WBondUp)+2 then begin

X := Lo(WBondDown);

dec(Y) end;

#10: inc(X,80); {LF}

#13: X :» Lo(WBondUp); {CR} else

MoveToScreen(VW,Pл,2);

end;

Inc(X); {Сдвигаема строке) if X-l>Lo(WBondDown) then {Достигнута правая граница окна} begin

X := Lo(WBondOp)+1; (Возвращаем к левой} inc(Y); {границе на новой строке} if Y-l>Hi(WBondDown) then

begin {Достигли нижнюю границу} {Делаем прокрутку с помощью прямого обращениях видеопамяти, т.к. функцич б работает только с активной страницей) dec (Y) ;

XI := Lo(WBondOp);

Yl :° Hi<WBondUp) ;

X2 := Lo(WBondDown);

Y2 := Hi(WBondDown);

Size := 2*(X2-X1+1);

for k :- Yl+1 to Y2 do begin MoveFromScreen(Mem[VMemory:Page*

VSize+(k*MaxChar+Xl)*2],But,Size) ;

MoveToScreen(Buf,Mem[VMemory:Page*

VSize+((k-l)*MaxChar+Xl)*2],Size) end;

for k := 1 to 1+X2-X1 do Buf[k,l] := ' •;

MoveToScreen(Buf,Mem[VMemory:Page*

VSize+(Y2*MaxChar+Xl)*2],Size) end end;

PutCursor(Page,X,Y) end end; {WriteChac} ^————.———————————————————————————*

I Многостраничные варианты подпрограмм модуля CRT I *———————————————————————————————*;

Procedure CIrEOL;

{Удаляет остаток строки справа от курсора в активной странице} var

XI,X2: Byte;

Р: Pointer;

X,Y: Byte;

Buf: array [1..80] of Word;

begin

GetCursor(ActivePage,X,Y,Xl,X2);


h0262.htm

with Pages[ActivePage] do begin

P := Ptr(VMemory,VMW[ActivePage*2]+ (Pred(Y)*MaxChar+Pred(X))*2) ;

X2 := PagePar[7]-X+2;

for X := 1 to X2 do

Buf[X] := 32+Attrib shi 8;

MoveToScreen(Buf,P^,X*2) end end; {CIrEOLf f—— _____————__——————;

Procedure CIrScr;

{Очищает текущее окно (страницу)} begin

with Pages[ActivePage],Reg do begin

AH := 6; 1 С помощью прокрутки}

AL := 0; {очищаем все окно}

ВН := Attrib;

CL := Lo(WBondUp) ;

СН := Hi(WBondUp);

DL :» Lo(HBondDown);

DH := Hi(HBondDown) ;

Intr($10,Reg) ;

AH :•= 2; f Устанавливаем курсор}

ВН := ActivePage; /'в левый верхний угол}

DX :° WBondUp;

Intr($10,Reg) end

end; {CIrScr} /—————————————————^

Procedure DelLine;

(Удаляет строку в активной странице) var k,

S, {Длина строки окна} У: Byte; (Номер строки с курсором} С: Word; {Смещение в памяти для левой границы окна} Buf: array [1..80,1..2] of Char; {Буфер строк) P: Pointer;

begin

{Стираем строку прокруткой окна вверх} with Pages[ActivePage] do begin

{Определяем положение в видеопамяти левой верхней границы окна) С := VMW[ActivePage*2]+PagePar[5]*2;

Y := PagePar[6]+Pred(HhereY);

S := (PagePar[7]-PagePar[5]+l)*2;

{Переносим по строкам} for К := 1+1 to PagePar[8] do begin

P := Ptr(VMemory,C+K*MaxChar*2);

MoveFromScreen (P",Q\if, a) •i P := Ptr(VMemory,C+(K-l)*MaxChar*2);

MoveToScreen(Buf,P",s) end;

{Готовим пустую строку} for К := 1 to 80 do begin

Buf[k,l] :" ' ';

Buf[k,2] := chr(Attrib)


h0263.htm

end;

{Выводим ее}

Р :- Ptr(VMemory,C+FagePai-[8]*MaxChar*2);

MoveToScreen(Buf,P",s) end

end; (DelLine} /————————————————;

Procedure GotoXY(X,Y: Byte);

{Устанавливает курсор в активной странице! begin

with Pages[ActivePage] do

PutCursor(ActivePage,Lo(WBondUp)+X,Hi(WBondUp)+Y) end; {GotoXYf ^————————————————;

Procedure InsLine;

(Вставляет пустую строку в активной странице} var

k,

S, {Длина строки окна}

Y: Byte; ' (Номер строки с курсором}

С: Word; {Смещение а памяти для левой границы окна)

Buf: array [1..80,1..2] of Char; {Буфер строк!

Р: Pointer;

begin

with Pages[ActivePage] do begin

{Определяем положение в видеопамяти левой верхней границы окна} С := VMW[ActivePage*2]+PagePar[5]*2;

Y := PagePar[6]+Pred(WhereY) ;

S := (PagePar[7]-PagePar[5]+l)*2;

{Переносим по строкам} for К :•= PagePar[8]-l downfco Y do begin

Р := Ptr(VMemory,C+K*MaxChar*2) ;

MoveFromScreen(P'',Buf,s);

P := Ptr(VMemory,C+(K+l)*MaxChar*2);

MoveToScreen(Buf,Р",з) end;

{Готовим пустую строку} for К :° 1 to 80 do begin

Buf[k,l] := ' ';

Buf [It, 2] := chr(Attrib) end;

{Выводим ее} Р :- Ptr(VMeroory,C+Y*MaxChar*2) ;

MoveToScreen(Buf,V,s) end end; {InsLine} ^—.———————————————;

Procedure TextBackGround(Color: Byte);

(Устанавливает цвет фона в активной странице} begin

Pages[ActivePage].Attrib :~

(Pages[ActivePage].Attrib and $8F) or (Color and $7) shi 4);

it ActivePage=0 then

CRT.TextBackGround(Color) •nd; fPageTextBackGround} ^———————————_—.———;


h0264.htm

264_________________________________ __ Приложение

Procedure TextColor(Color: Byte);

(Устанавливает цвет символов s активной странице) begin

Pages[ActivePage].Attrib :=

(Pages[ActivePage].Attrib and $70) or (Color and $8F) ;

if ActivePage=O then

CRT.TextColor(Color) end; {PageTextColor} {-.- ————.—————— ————/

Function WhereX: Byte;

{Возвращает горизонтальную координату курсора в активной странице} var

X,Y,U,D: Byte;

begin

GetCursor(ActivePage,X,Y,U,D) ;

WhereX := X-Lo(Pages[ActivePage].WBondUp) end; {WhereX} ^—.——————————————;

Function WhereY: Byte;

(Возвращает вертикальную координату курсора в активной странице} var

X,Y,U,D: Byte;

begin

GetCursor(ActivePage,X,Y,П,D);

WhereY := Y-Hi(Pages[ActivePage].WBondUp;

end; (WhereY} ^——.————————.————.———;

Procedure Window(XI,Y1,X2,Y2: Byte);

{Устанавливает окно в активной странице} begin

{Проверяем параметры обращения} if (XI in [1..MaxChar]) and (X2 in [1..MaxChar])

and (X2>X1) and (Yl in [1..MaxLine]) and (Y2 in [1..MaxLine]) and (Y2>Y1)

then with Pages[ActivePage] do begin

WBondUp := pred(Xl)+pred(Yl) shi 8;

WBondDown :» pred(X2)+pred(Y2) shi 8;

PutCursor(ActivePage,XI,Yl);

if ActivePage=0 then

CRT.Window(XI,Y1,X2,Y2) end end;

/ ^_—________________----—•._»_•----------»——-----^.А-

I Подпрограммы управления страницами \

ii-----------.--.---------------------------—-----'^

Function GetActivePage: Byte;

(Возвращает номер активной текстовой страницы} begin

GetActivePage := ActivePage end (GetActivePage};

——————————————————/

Procedure GetPage (Page: Byte; var Destin);

^Копирует текстовую страницу в оперативную память} begin

if Раде<-МахРаде then

MoveFromScreen(Mem[VMemory:VSize*page],Destin,MaxChar*MaxLine*2) end (GetPage};

I ——...—.——————————— •


h0265.htm

Function PageSaveSize: Word;

{Возвращает размер буфера, необходимый для сохранения текущего состояния видеостраницы} begin

PageSaveSize :« PageSize+SizeOf(PageType) end; {PageSaveSize} /————————————————;

Procedure PutPage (var Source; Page: Byte);

{Пересылает содержимое оперативной памяти в страницу видеопамяти! begin

if Page<=MaxPage then

MoveToScreen(Source,Mem[VMemory:VSize*Page],MaxChar*MaxLine*2) end {PutPage};

;-———————————————;

Procedure RestorePage(Page: Byte; var Buf);

{Восстанавливает текущее состояние страницы PAGE по содержимому буфера BUF} var

В: array [O.-MaxInt] of Byte absolute Buf;

begin

if Page>MaxPage then Exit;

MoveToScreen(B,VMP[Page]",PageSize) ;

Move(B[PageSize],Pages[Page],SizeOf(PageType));

if Page=ActivePage then

SetActivePage(ActivePage) end; {RestorePage} {.....—————————————}

Procedure SavePage(Page: Byte; var Buf);

{Сохраняет текущее состояние страницы PAGE в буфере BUF} var

В: array [O.-MaxInt] of Byte absolute Buf;

begin

if Page>MaxPage then Exit;

MoveFromScreen (VHP [Page] ",B, PageSize);

Move(Pages[Page],В[PageSize],SizeOf(PageType)) end; {SavePage} _•——__———————— ..,-——}

Procedure SetActivePage (Page : Byte);

(Активизирует заданную текстовую страницу} begin

if Page<-MaxPage then with Reg,Pages[Page] do begin

AH := 5; {Установить страницу} AL := Page; {Номер страницы} ActivePage :=' Page; lКорректируем ActivePage} Intr ($10,Reg);

if CVisible then {Включаем/отключаем}

CursorOn {курсор} else

CursorOff;

TextAttr :== Attrib; {Устанавливаем атрибут} WindMin := WBondUp; {Текущее окно} WindMax := WBondDown end;

end {SetActivePage};

/————————————————;

Procedure SwapPage (Source, Destin: Byte);

{ Копирует одну текстовую страницу в другую } var

buf : array [1..2, 1..80] of Byte;


h0266.htm

i : integer;

begin

if (Source<=MaxPage) and (Destin<=MaxPage) then for i := 0 to MaxLine-1 do begin

MoveFromScreen (Mem [VMemory :VSi2e*Source+i*Ma.xChar*2] ,buf,MaxChar*2) ;

MoveToScreen(buf,Mem[VMemory:VSize*Destin+i*MaxChar*21,MaxChar*2) end end /SwapPage];

I Подпрограммы управления окнами 1 *———————————————————.——————————*;

Procedure ChangeWindAttribute(Page,01dAtt,NewAtt: Byte);

{Заменяет в окне атрибут OLDATT на значение NEWATTf var

X1,Y1,X2,Y2: Byte;

begin

if Page<=MaxPage then with Pages[Page] do begin

XI :° Lo(WBondUp) ;

Yl := Hi(WBondUp) ;

X2 := Lo(WBondDown)+2;

Y2 := Hi(HBondDown)+2;

ChangeAttribute(Page,XI,Yl,X2,Y2,OldAtt,NewAtt) end

end; {ChangeWindAttribute} ^———————————————/

Procedure CopyWind(Page,X,Y: Byte; var Buf;,LX,LY: Byte);

{Переносит копию окна из яамяги на страницу} var

X2,Y2,k: Byte;

Size: Word;

В: array [O.-MaxInt] of Byte absolute Buf;

begin

if (X in [1..MaxChar]) and (Y in [1..MaxLine]) and (Page<=MaxPage) then with Pages[Page] do begin

X2 := X+LX-1;

if X2>MaxChar then X2 := MaxChar;

Y2 := Y+LY-1;

if Y2>MaxLine then У2 := MaxLine;

Size := (X2-X+1)*2;

for k := У to Y2 do

MoveToScreen(B[(k-Y)*LX*2],Mem[VMemory:Page*VSize+ (pred(k)*MaxChar+X-l)*2],Size) ;

WBondUp := X+Y shi 8;

WBondDown := X2-2+(Y2-2) shi 8;

if Page=ActivePage than

SetActivePage(Page) end

end; (Copy Wind} ^_————_————————_—;

Procedure GetWindow (Page: Byte);

(Восстанавливает состояние экрана, бывшее перед обращением к процедуре PUTWIVDOW} var

X,Y,U,D: Byte;


h0267.htm

begin

if (Page<-MaxPage) and (PagaoActivePage) then begin

SwapPage(Page,ActivePage);

Move(Pages[Page],Pages[ActivePage],SiaeOf(PageType));

GetCursor(Page,X,Y,U,D) ;

PutCursor(ActivePage,X,Y);

SetCursorLine(ActivePage,U,D);

SetActivePage(ActivePage) end end {GetSfindow};

^-.___—————————————;

Procedure PutHindow(Xl,Yl,X2,Y2,Text,Back,Bord,Page: Byte;

Header: String; Clip,Build,Play: Boolean);

{Сохраняет текущий экран в текстовой странице PAGE и организует окно с заданными атрибутами и рамкой} var

X,Y,U,D: Byte;

begin

if not ((Page>MaxPage) or (XK1) or (X2<-X1) or (Y1<1) or (Y2<=Y1) or (X2>MaxChar) or (Y2>MaxI»ine) or (Bord>2)> then begin

SwapPage(ActivePage,Page);

Move(Pages[ActivePage],Pages[Page),SizeOf(PageType));

GetCursor(ActivePage,X,Y,U,D);

PutCursor(Page,X,Y) ;

SetCursorLine(Page,U,D);

Colors(Text,Back);

SetWindow(XI,XI,X2,Y2,Bord,Header,Clip,Build,Play) end;

end {PutWindo»);

_-.——————————————;

Procedure SaveWind(Page: Byte; var Buf; var LX,LY: Byte);

{Сохраняет копию окна в буфере BUF} var

X1,Y1,X2,Y2: Byte;

В: array [O-.MaxInt] of pyte absolute Buf;

k: Byte;

begin

if Page<=-MaxPage then with Pages [Page] do begin

XI » Lo(WBondUp) ;

Yl = Hi(WBondUp) ;

X2 = Lo(WBondDown)+2;

Y2 ° Hi(WBondDown)+2;

LX = X2-X1+1;

LY = Y2-Y1+1;

for k :== Yl to Y2 do

MoveFromScreen (Mein[VMemory:Page*VSi2e+

(pred(k)*MaxChar+Xl-l)*2],B[(k-Yl)*LX*2],LX*2) end end; {SaveWind) ^_———————————————;

Procedure SetPageWindow (Page,XI,Y1,X2,Y2,Bord: Byte;

Header: String;Clip: Boolean);

(Создает окно в странице PAGE и обводит его рамкой} var

buf: array [1..80,1..2] of Byte;

X,Y,Size,k: Byte;


h0268.htm

begin

i? not ( (Page>MaxPage) or (X1<1) or (X2<-X1) or (УК1) or (Y2<=Y1) or (X2>MaxChar) or (Y2>MaxLine) or (Bord>2)) then begin

(Очищаем прямоугольное окно на экране} Size := Х2-Х1+1;

for Y := 1 to Size do begin

buf[Y,ll := ordC •);

bu?[Y,2] :» Pages[Page].Attrib end;

Size := Size+Size;

for Y := Yl to Y2 do

MoveToScreen(Buf,Mem[VMemory:Page*VSize+ (pred(Y)*MaxChar+pred(Xl))*2],Size) ;

{Обводим его рамкой и выводим заголовок} if BordOEmptyBorder then

Border(Page,XI,Yl,X2,Y2,Bord);

if Length(Header)>0 then begin

if Length(Header)>X2-X1-2 then Header[0] :» chr(X2-Xl-2);

X := Xl+(X2-Xl-Length(Header)) div 2;

for k := 1 to Length(Header) do

WriteCharXY(Page,X+k,Yl,Header W);

end;

{Корректируем границы внутрь прямоугольника XI...Y2, если признак Clip равен Гrue^ if Clip then begin inc(XI) ;

inc (YD ;

dec(X2);

dec(Y2) end;

{Устанавливаем курсор в левую вершину ft запоминаем координаты} dec(XI); (Преобразуем координаты} dec(Yl); {к началу в точке 0,0} dec(X2);

dec(Y2) ;

PutCursor(Page,Xl+l,Yl+l);

Pages[Page 1.WBondUp :-X1+Y1 shi 8;

Pages[Page 1.WBondDown :=X2+Y2 shi 8;

if page=ActivePage then

SetActivePage(Page) end end {SetPageWindow};

^———————————————————————-.Jl

Procedure SetWindAttribute(Page,Attr: Byte);

{Устанавливает новый атрибут окна} var

X1,Y1,X2,Y2: Byte;

begin

if page<-MaxPage then with Pages[Page] do begin

XI :° Lo(WBondUp) ;

XI := Hi(WBondUp) ;

X2 :- Lo(WBondDown)+2;

Y2 :» Hi(WBondDown)+2;


h0269.htm

Тексты программ 269

SetAttribute(Page,Xl,Yl,X2,Y2,Attr) end

end; {SetWindAttribute} ^——————————————/

Procedure SetWindow (Xl,Yl,X2,Y2,Bord: Byte;

Header: String; Clip,Build,Play: Boolean);

{Создает окно в активной странице и обводит его рамкой} var

xxl,yyl,xx2, yy2,x,y,dx,dy,k: Byte;

dt: Integer;

const

TonBeg = 400; {Начальный тон I TonEnd •" 800; {Конечный тон} Pause - 5;

N = 10;

begin

if Build and ((x2-xl>-4) or (y2-yl>=4)) then

begin

{Начальное положение левого верхнего угла окна} х := (x2-xl) div 2;

у := (у2-у1) div 2;

(Количество промежуточных окон} dx := ((x2-xl) div 2) div N;

dy := ((y2-yl) div 2) div N;

if dx=0 then inc(dx) ;

if dy-0 then inc(dy);

if x>l then begin

xxl := xl+x-1;

xx2 :" x2-x+l end else begin

xxl :- xl;

xx2 :- x2 end;

if y>l then begin

yyl :- yl+y-1;

yy2 := y2-y+l end else begin

yyl :» yl;

yy2 :- y2 end;

(Изменение тона}

dt := (TonEnd-TonBeg) div N;

for k :» 0 to N-1 do {Цикл построения} begin

if Play then

Sound (TonBeg+dt*k) ; (Включаем э-вук/ SetPageWindow(ActivePage,xxl,yyl,xx2,yy2,Bord,Header,Clip);

(Увеличиваем границы окна} if xxl>xl then dec(xxl,dx) ;

if xx2<x2 then


h0270.htm

inc (xx2,dx) ;

if yyl>yl then dec(yyl,dy);

if yy2<y2.then inc(yy2,dy) ;

Delay(Pause) end;

if Play then NoSound;

end;

SetPageWindow(ActivePage,XI,Yl,X2,Y2,Bord,Header,Clip) end; {SetWindow} /—————_———_—____——;

Procedure WindMoveRel(Page: Byte; DX,DY: Integer; var Buf; ClipW: Boolean);

{Смещает окно относительно прежнего положения:

PAGE - номер страницы;

DX,DY- приращения координат левого верхнего угла;

BUF - вид экрана без окна;

CLIPW- признак отсечки изображения} чах

X,Y: Byte;

begin

if Page<=MaxPage then with Pages[Page] do begin

X := Lo(WBondUp) ;

Y := Hi(WBondUp) ;

if X+DX<1 then

X := 1 else if X+DX>MaxChar then

X := MaxChar else

X := X+DX;

if Y+DY<1 then Y := 1

else if Y+DY>MaxLine then

Y := MaxLine else

Y := Y+DY;

WindMoveTo(Page,X,Y,Buf,ClipW) end end; {WIndMovRel} ^_____________________——;

Procedure WindMoveTo(Page,X,Y: Byte; var Buf; ClipW: Boolean);

{Перемещает окно в новое положение:

PAGE - номер страницы,' X,Y - новые координаты левого верхнего угла;

BUF - вид экрана без окна;

CLIPW- признак отсечки изображения} var

X2,Y2,LX,LY: Byte;

Сор: array [1..4OOO] of Byte;

begin

if (X in [1..MaxChar]) and (Y in [1..MaxLine])

and (Page<=MaxPage) then with Pages[Page] do begin {Копируем окно в буфер Сор}

SaveWind(Page,Cop,LX,LY);

{Восстанавливаем вид страницы}

MoveToScreen (Buf, VMP [Page] ^PageSize);


h0271.htm

Тексты программ 271

if not ClipW then {Корректируем положение} begin

while X+LX-l>MaxChar do dec (X) ;

while Y+LY-l>MaxLine do

dec(Y) end;

{Переносим окно на новое место}

CopyWind(Page,X,Y,Cop,LX,LY) ;

{Запоминаем новые границы окна} it Page=ActivePage then

SetActivePage(Page) end end; {WindMoveTo} f—— ——-.————————-.————;

Function WindSize(Page: Byte): Word;

{Возвращает размер буфера для сохранения окна} var

X1,Y1,X2,Y2: Byte;

begin

if Page<=MaxPage then with Pages[Page] do begin

XI := Lo(WBondUp) ;

Yl := Hi(WBondUp) ;

X2 := Lo(WBondDown)+2;

У2 :» Hi(WBondDown)+2;

WindSize := (X2-X1+1) * (Х2-П+1) *2 end else

WindSize := 0 end; {WindSize} /===»====»=.==; end. {TextCRT} /==.=====-..«——/

П2. МОДУЛЬ ПОДДЕРЖКИ ТЕКСТОВОГО ВВОДА/ВЫВОДА В ГРАФИЧЕСКОМ РЕЖИМЕ F.GRTEXT

Описание модуля см. п. 1.3.

{$N+,E+} ^=====»»=====; onit F_GrText; ^=s=——-=—»—»==;

/

Модуль поддержки текстового ввода/вывода

в графическом режиме

} ^—————————————————————————————/

INTERFACE

^—————————————————————————————}

Uses DOS,Graph,CRT;

const

AppHandle: Boolean = True; {Флаг управления аппаратной поддержкой CGA/EGA/VGA)

ESCFlag : Boolean = False; {Флаг завершения ввода no ESC} {

Следующие константы используются для указания типа рамки при обращении к процедуре SETtlINDOff. } const

EmptyBorder - 0; {Стереть рамку}


h0272.htm

SingleBorder =• 1; {Рамка из одинарных линий) DoubleBorder ==2; /Рамка из двойных линий} I

Следующий массив определяет символы псевдографики для вычерчивания рамок (альтернативная кодировка) } const

BorderChar: array [0..2,1..6] of Char = ((#32, #32, #32, #32, #32, #32), (#218, #196, #191, #179, #192, #217), (#201, #205, #187, »18б, #200, #188));

Procedure CIrScr;

{Очищает текстовое окно или экран)

Procedure Colors(Text,Back: Byte);

(Устанавливает цвета для текстового вывода}

Function GetMaxChar: Byte;

{Возвращает максимальное количество символов на строке}

Function GetMaxLine: Byte;

{Возвращает максимальное количество строк на экране}

Procedure GetWindGraphCoo(var X1,Y1,X2,Y2: Integer) ;

(Возвращает графические координаты текстового окна)

Procedure GotoXY(X,Y: Byte);

{Перемещает курсор в заданную позицию}

Function GraphCooX(X: Byte): Integer;

{Возвращает графическую координату по заданной горизонтальной текстовой координате}

Function GraphCooY(Y: Byte): Integer;

{Возвращает графическую координату по заданной вертикальной текстовой координате}

Procedure GraphWriteOn;

{Переназначает стандартные каналы ввода/вывода на процедуры Graph Write и GraphRead}

Procedure GraphWriteOff;

{Восстаналивает стандартные каналы ввода/вывода}

Procedure SetFontfFnt: Pointer; X,Y: Byte);

{Устанавливает текущий шрифт для текстового ввода/вывода}

Procedure Scrolling(N: Integer);

{Осуществляет сдвиг содержимого окна вверх или вниз:

N - количество строк, на которые сдвигается окно (N < 0 - сдвиг вниз)}

Procedure TextBackGround(Color: Byte);

{Устанавливает цвет фона для символов}

Procedure TextColor(Color: Byte);

{Устанавливает цвет символов}

Function TextCooXfX: Integer): Byte;


h0273.htm

(Возвращает ближайшую текстовую координату по заданной горизонтальной графической координате}

Function TextCooY(Y: Integer): Byte;

{Возвращает ближайшую текстовую координату по заданной вертикальной графической координате}

Function WhereX: Byte;

{Возвращает горизонтальную координату курсора}

Function WhereY: Byte;

{Возвращает горизонтальную координату курсора}

Procedure Window(Xl,Yl,X2,Y2: Byte);

{Устанавливает текстовое окно}

Procedure SetWindow(Xl,Yl,X2,Y2,BordeJ:: Byte;

Header: String; Clip,Build,Play: Boolean);

{Устанавливает окно, очищает его и обводит рамкой}

Function RegisterCHRFile(S: String): Integer;

{Регистрирует векторный шрифт, содержащийся в файле с именем S, и возвращает порядковый номер шрифта)

Function RegisterCHRFont(Font: Pointer): Integer;

{Регистрирует векторный шрифт, загруженный в память по адресу Font, и возвращает порядковый номер шрифта}

Procedure OutString(S: String; Font: Integer; Angle: Integer; MX,MY: Real) {Выводит с помощью векторного шрифта Font строку S с поворотом на угол Angle и с масштабными коэффициентами MX,MY}

^_—————————————————————————————;

IMPLEMENTATION

^———————————————————..——————————;

type

aob = array [O.-MaxInt] of Byte;

const

ChangeWR: Boolean -e False; (Признак замены драйвера вывода} Font: лaoЬ = NIL; {Адрес массива шрифта} TCol: Byte = LightGray; {Цвет символов} BCol: Byte - Black; {Цвет фона}

var

OldOut, OldInp: Text;

Xt: Byte; (Горизонтальная координата курсора} Xg: Integer;

Yt: Byte; {Вертикальная координата курсора} Yg: Integer;

Xlt,Ylt,X2t,Y2t: Byte; {Координаты активного окна} Xlg,Ylg,X2g,Y2g: Integer;

MaxChar: Byte; {Длина текстовой строки экрана} MaxLine: Byte; {Количество строк на экране} XF: Byte; {Ширина символа в пикселах} YF: Byte; (Высота символа в пикселах} Adapter: Byte; (Признак аппаратуры адаптера}

Procedure WriteChar(X,Y: Integer; Ch: Byte);

{Выводит символ с кодом Ch в позицию X,У} var


h0274.htm

k: Integer;

b: Byte;

j: Byte;

begin

for k := 0 to predd'F) do begin

b := Font" [Ch*YF+lc] ;

case Adapter of

О: {Вывод без аппаратной поддержки}

begin

for j := 0 to 7 do

if b and (128 shr j)<>0 then

PutPixel(X*XF+j,Y+k,TCol) else if BColoO then

PutPixel(X*XF+j,Y+k,BCol) end;

1: {Аппаратная поддержка EGA/VGA}

asm

{Вычисляем адрес байта а видеопамяти}

mov ax,$AOOO

mov es,ax {es = $АООО}

mov bx, у (Ьх = у)

add bx,k (Ьх » (y-l-k) }

mov cl,4

shi bx,cl

mov dx,bx {dx » (y+k>*16}

mov ci,2

shi bx,cl {bx = <y+k)*64f

add bx,dx {bx = (y+k) *80)

add bx,x {bx = (y+k)*80+x} {Устанавливаем режим записи 2]

mov dx,$3CE

mov al,5

out dx,al

inc dx

mov al,2

out dx,al {Разрешаем изменять только биты символа}

mov dx,$3CE

mov al,8

out dx,al

inc dx

mov al,b {Разрешены биты символа}

out dx,al

{Выводим символ}

mov al,es: [bx]

mov al,TCol

mov es:[bx],al {Проверяем фоновый цвет}

mov dl,BCol

cmp dl, 0

je @0 {Изменяем биты фона для создания фонового цвета}

mov dx,$3CE

mov al,8 {Регистр маски битов}

out dx,al

inc dx

mov al,b {Разрешить изменение}

not al {разрядов фона}

out dx,al


h0275.htm

{Выводим фон) mov al,es:[bx] mov al,BCol

mov es:[bx],al {Устанавливаем все биты} @0:

end;

end end end; {WriteChar} /———————————————;

Function GraphRead(var F: TextRec): Integer; Far;

(Осуществляет ввод текста для процедур Read/ReadLn} var

XOt : Byte; {Начальное положение курсора}

YUp,YDn: Integer; {Размер курсора}

InsFlag: Boolean; {Флаг режима вставки}

Cur : Pointer; (Изображение курсора}

Back : Pointer; {Фон курсора}

S : String; {Строка ввода}

С '. Char; {Очередной символ} const

CSize: Word =• 0;

Procedure SetCursor;

{Устанавливает форму курсора} var

Filllnfo: FillSettingsType;

begin

if CSizeOO then begin

FreeMem(Back,CSize) ;

FreeMem(Cur,CSize) end;

YDn :== Yg+YF-1;

if InsFlag then YUp := YDn - 2

else

YUp :- Yg;

CSize := ImageSize(Xg,YUp,Xg+XF-l,YDn) ;

GetMem(Back,CSize) ;

Getlmage (XgiYUp^g+XF-l^YDr^Back^) ;

GetFillSettings(Filllnfo) ;

SetFillStyle(SolidFill,TCol) ;

Bar(Xg,YUp,Xg+XF-l,YDn) ;

with Filllnfo do

SetFillStyle(Pattern,Color) ;

GetMem(Cur,CSize) ;

Getlmage(Xg,YUp,Xg+XF-1,YDn,Cur^) ;

PutImage (XgyYUptBack^NormalPut) ;

end; {SetCursor} {——————}

Procedure Cursor;

{Создает изображение мигающего курсора} var

k: Integer;

const

D = 10;

begin

Getlmage(Xg,YUp,Xg+XF-1,YDn,Bac^) ;

while not KeyPressed do begin


h0276.htm

276___ ____________ __________ ____________Приложение

PutImage(Xg,YUp,Cur",NormalPut);

for k :- 1 to 10 do

if not KeyPressed then Delay(D) ;

PutImage(Xg,YUp,Back^,NormalPut);

for k :- 1 to 10 do

if not KeyPressed then

Delay(D) end end; {Cursor} {—————} Procedure Home;

{Курсор - в начало строки ввода} begin

GotoXY(XOt,WhereY) ;

end; {Home} {—————} Procedure Left;

{Курсор - на символ влево} begin

if WhereX>XOt then

GotoXY(WhereX-1,WhereY) end; {Left} {—————} Procedure Right;

{Курсор - на символ вправо} begin

if WhereX-XOt<Length(s) then

GotoXY(WhereX+1,WhereY) end; {Right} {—————} Procedure EndKey;

{Курсор ~ в конец строки} begin

GotoXY(XOt+Lengthfs),WhereY) end; {EndKey} {—————] Procedure Ins;

{Переключение режима ввода} begin

InsFlag := not InsFlag;

SetCursor end; {Ins} {—————} Procedure WriteString;

{Восстанавливает ввод после редактирования} var

k: Byte;

begin

for k :- 1 to Length(S) do

WriteChar(Xlt+XOt+k-3,Yg,ord(S[k])) ;

WriteChar(Xlt+XOt+Length(S)-2,Yg,32) end;

(—————} Procedure Del;

{Забить символ с курсором} var

n: Byte;

begin


h0277.htm

n := WhereX-XOt;

if n<Length(S) then begin

Delete (S,n+l,l) ;

WriteString end end; {Del} {—————} Procedure Backspace;

(Забить символ слева от курсора} vac

n: Byte;

begin

n := WhereX-XOt;

if n>=l then begin

Delete(S,n,l) ;

WriteString;

GotoXY(WhereX-l,WhereY) end end; {Backspace} !—————} Procedure AnyChar;

var

n: Byte;

begin

n := WhereX-XOt;

if n»Length(S) then

if Xlt+XOt+Length(S)<-X2t then

S := S+c else else

if InsFlag and (Xlt+XOt+Length(S) <»S<2t) then

Insert (C,S,n+l) else

S[n+l] := C;

WriteString;

GotoXY(WhereX+l,WhereY) end; {AnyChar} {—————} Procedure Enter;

{Завершает ввод по клавише Enter} var

k: Byte;

begin

with F do begin

for k := 1 to Length(S) do BufPtr"[BufEnd+k-1] := S[k];

BufEnd := Length(S);

if BufEnd°0 then begin

BufEnd := 1;

BufPtr"[0] := ' ' end end;

GotoXY(l,WhereY+l) end; {Enter} (—————}


h0278.htm

Procedure ESC;

{Выход по клавише ESCf begin

with F do begin

BufEnd :=° 1;

BufPtr^tO] := • ';

ESCFlag := True end end; {ESC} {—————} begin (GraphRead}

with F do if (Mode-fminput) and (BufEnd»0) than begin

XOt := WhereX;

InsFlag := True;

ESCFlag := False;

SetCursor;

repeat

Cursor;

с := ReadKey;

case с of

#0: case ord(ReadKey) of 71: Home;

75: Left;

77: Right;

79: EndKey;

82: Ins;

83: Del;

else

с := #0 end;

#8: Backspace;

#13: Enter;

#27: ESC;

else

AnyChar end;

until (c-#13) or (c=#27) ;

FreeMem(Back,CSize) ;

FreeMem(Cur,CSize) ;

CSize :- 0 end;

GraphRead := 0 end; {GraphRead} ^____—————————————;

Function GraphWrite(var F: TextRec;: Integer; Far;

{Осуществляет вывод текста} var

Drv,Mode: Integer;

k: Integer;

Reg: Registers;

begin

if Font=NIL then exit;

DetectGraph(Drv,Mode) ;

if AppHandle and (Drv in [3..5,9]) then Adapter :- 1 {EGA, VGA}

else


h0279.htm

Тексты программ_______________________________ _______279

Adapter := 0; {Другие типы или нет AppHandle} with F do

if (Mode=fm0utput) and (BufPos>0) then begin

for k := 0 to BufPos-1 do case BufPtr'^k] of

#7: with Reg do

begin {Звук}

ah := $E;

al := 7;

Intr($10,Reg) end;

#8: if k>BufEnd then

begin (Забой слева от курсора}

WriteChar(Xt-2,Yg,32) ;

GotoXY(WhereX-l,WhereY) end;

#10: if Yt+1 in [Ylt..Y2t] then /Перевод строки} GotoXY(WhereX,WhereY+l) ;

#13: {Возврат каретки} GotoXY(l,WhereY) ;

else begin

WriteChar(Xt-l,Yg,ord(BufPtrA(lt])) ;

if Xt+1 in [Xlt..X2t] then

GotoXX(WhereX+l,WhereY) else if Yt+1 in [Ylt..Y2t] then

GotoXY(l,WhereY+l) end end;

BufPos :•= 0 end;

GraphWrite := 0 end; {Graphfirite} ^———————————————;

Function Zerofvar F: TextRec): Integer; Far;

{Заглушка для функций Open/Close} begin

Zero := 0 end; {Zero} _•————————————————;

Function Mush (var F: TextRec): Integer; Far;

(Обнуляет буфер ввода} begin

with F do begin

BufPos := 0;

BufEnd := 0 end;

Flush := 0 end;

/————————————————;

Procedure CIrScr;

(Очищает текстовое окно или экран} var

FillInfo: FillSettingsType;

begin

if FontoMIL then begin


h0280.htm

280 Приложение

GetFillSettings(Filllnfo);

SetFillStyle(SolidFill,BCol) ;

Bar(Xlg,Ylg,X2g,Y2g);

with Filllnfo do

SetFillStyle(Pattern,Color) ;

GotoXY(l,l) end end; {CIrScr} {„. —————————— ————;

Procedure Colors(Text,Back: Byte);

(Устанавливает цвета для текстового вывода} begin

TextColor(Text);

TextBackGround(Back) end; {Colors} {., _———————. ———.——;

Function GetMaxChar: Byte;

{Возвращает максимальное количество символов на строке} begin

GetMaxChar := MaxChar end; {GetMaxChar} /————————————————;

Function GetMaxLine: Byte;

{Возвращает максимальное количество строк} begin

GetMaxLine :"= MaxLine end; {GetMaxLine} {-, ———————— —————_-;

Procedure GetWindGraphCoo(var X1,Y1,X2,Y2: Integer);

!Возвращает графические координаты текстового окна} begin

XI := Xlg;

Yl :° Ylg;

X2 :- X2g;

Y2 :=• Y2g

end; {GetWindGraphCoo} /——___———— ——————,——;

Procedure GotoXY(X,Y: Byte);

^Перемещает курсор в заданную позицию} begin

if (FontoMIL) and (X in [1. .MaxChar]) and

(Y in [1..MaxLine]) and (X<=X2t-Xlt+l) and (Y<=Y2t-Ylt+l) then begin

Xt :» X+Xlt-1;

Yt := Y+Ylt-1;

Xg := GraphCooX(Xt) ;

Yg := GraphCooY(Yt) end end; {GotoXY} f,- _——————__———————;

Function GraphCooX(X: Byte): Integer;

{Возвращает графическую координату по заданной горизонтальной текстовой координате} begin

if FontoHIL then

GraphCooX := pred(X)*XF else

GraphCooX :•= -1 end; {GraphCooX}


h0281.htm

/-—.————————;

Function GraphCooY(Y: Byte): Integer;

{Возвращает графическую координату по заданной вертикальной текстовой координате) begin

if FontoNIL then

GraphCooX :- pred(Y)*YF

else

GraphCooY := -1 end; {GraphCooY} ^————————————————;

Procedure GraphWriteOn;

{Переназначает стандартные каналы ввода/вывода на процедуры GraphWrite и -GraphReadf begin

if not ChangeWR then begin

Move(Output,OldOut,SizeOt(Output)) ;

with TextRec(Output) do begin

OpenFunc :== SZero;

CloseFunc := @Zero;

FlushFunc := OGraphWrite;

InOutFunc :" SGraphWrite end;

Move(Input,Oldlnp,SizeOf(Input)) ;

with TextRec(Input) do begin

OpenFunc := @Zero;

CloseFunc := @Zero;

FlushFunc :" SFlush;

InOutFunc := @GraphRead end;

ChangeWR := True end end; {GraphlfrlteOn} {„. ———————.——————;

Procedure GraphWriteOff;

(Восстаяаливает стандартные каналы ввода/вывода) begin

if ChangeWR then begin

Move(OldOut,Output,SizeOf(Output)) ;

Move(Oldlnp,Input,SizeOf(Input));

ChangeWR := False end end; I Graph»rlteOff} ^————————————————;

Procedure SetFont(Fnt: Pointer; X,Y: Byte) ;

{Устанавливает текущий шрифт для текстового ввода/вывода! begin

Font := Fnt;

MaxChar := succ(GetMaxX) div X;

MaxLine :== succ (GetMaxY) div У;

XF := X;

YF :- Y;

Window(1,l,MaxChar,MaxLine) end; {SetFont} _.————————————————^


h0282.htm

282 Приложение

Procedure Scrolling(N: Integer);

{Осуществляет сдвиг содержимого окна вверх или вниз;

N - количество строк, на которые сдвигается окно (N < 0 - сдвиг вниз)} var

k: Byte;

х,у: Word;

LineSize: Word;

P: Pointer;

Filllnfo: FillSettingsType;

begin

GetFillSettings(Filllnfo) ;

SetFillStyle (SolidFUl.BCol) ;

LineSize :- ImageSize(xlg,ylg,x2g,ylg+YF);

if abs(N»=Y2t-Ylt+l then

Bar(xlg,ylg,x2g,y2g) (Очистить окно} else if N>0 then

begin {Сдвиг вверх} GetMem(P,LineSize);

for k := 0 to YZt-Ylt-N do begin

GetImagetxIgtylg+lN+krYFfXPgtylg+fN+k+l^YF,?^) ;

PutImage(xlg,ylg+k*YF,P",NormalPut) end;

FreeMem(P,LineSize);

Bar(xlg,y2g-N*YF,x2g,y2g) and else if N<0 then

begin {Сдвиг вниз! GetMem(P,LineSize);

N :=- abs(N) ;

for k :- Y2t-Ylt-N downto 1 do begin

Getlmage(xlg,ylg+(k-1)*YF,x2g,ylg+k*YF,P^ ;

PutImage(xlg,y2g-(Y2t-Ylt-N-k+l)*YF,P",NormalPut) end;

FreeMem(P,LineSize) ;

Bar(xlg,ylg,x2g,ylg+N*XF) end;

with Filllnfo do

SetFillStyle(Pattern,Color) end; {Scrolling} /————————————————;

Procedure TextBackGround(Color: Byte);

(Устанавливает цвет фона для символов} begin

BCol := Color end; f TextBackGround} _•————————————————;

Procedure TextColor(Color: Byte);

{Устанавливает цвет символов} begin

TCol :== Color end; {TextColor} ,———————.———— —————^

Function TextCooX(X: Integer): Byte;

{Возвращает ближайшую текстовую координату по заданной горизонтальной графической координате} begin

it (FontoNIL) and (X in [0. .GetMaxX]) then


h0283.htm

Тексты программ_____ ______________________ _____________283

TextCooX := round(X/MaxChar)+1 else

TextCooX := 0 end; {TextCooX}

^——————————.————;

Function TextCooX(Y: Integer): Byte;

(Возвращает ближайшую текстовую координату по заданной вертикальной графической координате! begin

if (FontoNIL) and (Y in [0. .GetMaxY]) then TextCooY := round(Y/MaxLine)+1

else

TextCooY := 0 end; {TextCooY} ^__————_——————————;

Function WhereX: Byte;

(Возвращает горизонтальную координату курсора} begin

if FontOMIL then

WhereX := Xt-Xlt+1 else

WhereX := 0 end; {WhereX} ^__——————————————/

Function WhereY: Byte;

^Возвращает горизонтальную координату курсора} begin

if FontOMIL then

WhereX := Yt-Ylt+1 else

WhereY := 0 end; (fihereY} ^_-_———————————————;

Procedure Window(XI,Y1,X2,Y2: Byte);

{Устанавливает текстовое окно} begin

if (FontoNIL) and (XI in [1. .MaxChar]) and (Yl in [1..MaxLine]) and (X2 in [1..MaxChar]) and (Y2 in [1..MaxLine]) and (X2>=X1) and (Y2>=Y1) then begin

Xt := XI;

Yt := Yl;

Xg :== XF*pred(Xt) ;

Yg := YF*pred(Yt) ;

Xlt := XI;

Ylt := Yl;

X2t := X2;

y2t := Y2;

Xlg := XF*pred(Xlt) ;

Ylg := YF*pred(Ylt) ;

X2g := XF*X2t;

Y2g := YF*Y2t end end; {Window} ^————————————————;

Procedure SetWindow(XI,Y1,X2,Y2,Border: Byte;

Header: String; Clip,Build,Play: Boolean);

(Устанавливает окно, очищает его и обводит рамкой}


h0284.htm

const

TonBeg = 400;

TonEnd = 800;

Pause = 5;

N = 20;

var

k,X,xxl,yyl,xx2,yy2,dx,dy: Byte;

dt: Integer;

begin

if (FontOMIL) and (XI in [1. .MaxChar]) and (Yl in [1..MaxLine]) and (X2 in [1..MaxChar1) and (Y2 in [1..MaxLine]) and (X2>=X1) and (Y2>=Y1) then begin

if Build and ((X2-X1>"4) or (X2-X1>-4)) tben begin

X := (X2-X1) div 2;

if X>1 then begin

xxl :» Xl+X-l;

xx2 := Xl+X+1 end else begin

xxl :" XI;

xx2 := X2 end;

X := (Y2-Y1) div 2;

i.? X>1 then begin

yyl := У1+Х-1;

yy2 := У1+Х+1 end else begin

yyl :- Yl;

yy2 := У2 end;

dx := (X2-X1) dULv N;

if dx=0 then dx := 1;

dy := (Y2-Y1) div Ы;

i? dy=0 then dy := 1;

dt := (TonEnd-TonBeg) div N;

for k :» 0 to N-1 do begin

if Play then

Sound(TonBeg+k*dt) ;

Window (x-xl, yyl, xx2, yy2) ;

CIrScr;

if xxl>xi then dec (xxl,dx) ;

if xx2<X2 then inc (xx2,dx) ;

if уу1>У1 then dec(yyl,dy) ;

if yy2<Y2 then inc(yy2,dy) ;

end;


h0285.htm

мойоипа end;

Window(XI,Y1,X2,Y2) ;

CIrScr;

i? Border in [0..2] then begin

Write(BorderChar[Border,1]);

for k := 2 to X2-X1 do

Write(BorderChar[Border,2]);

Write(BorderChar[Border,3]) ;

for k := 2 to Y2-Y1 do begin

GotoXY(l,k) ;

Write(BorderChar(Border,4] )• t GotoXY(X2-Xl+l,k) ;

Write(BorderChar[Border,4]) end;

GotoXY(l,Y2-Yl+l) ;

Write(BorderChar[Border,5]);

for k :" 2 to X2-X1 do

Write(BorderChar[Border,2]) ;

Write(BorderChar[Border,6]) end;

if Length(Header)>0 then begin

if Length(Header)>X2-X1-2 then Header[0] :- chr(X2-X1-2):

GotoXY((X2-Xl-Length(Header)) div 2+2,1) ;

Write(Header) end;

if Clip then

Window(Xl+l,Yl+l,X2-l,Y2-l) end end; fSetffindow} ^-—————————.————————————————+

I Поддержка вывода сообщений вектортши I I шрифтами 1

+-------------—----—--—-——---—------——+;

type

PFontDesc =^TFontDesc;

TFontDesc = record {Описатель шрифта)

NextFont: PFontDesc; (Ссылка на следующий}

NFont : Integer; {Номер шрифта}

Name: record

case Byte of

0:(FName: String); (Имя файла)

l:(Flag : Byte; {Флаг формата) Addrs: record {Адрес}

sa,oa: Word end;

end;

FirstChr : Byte; {Первый сиывол}

LastChar : Byte; {Последний символ}

Height: ShortInt; {Высота от базы}

Bottom: ShortInt; {Высота до низа)

Offs: array [0..255] of Word; {Смещения!

Leng: array [0..255] of Word; {Длины} end;

TFontPara = record {Блок параметров шрифта/


h0286.htm

286 Приложение

ParPrefix : Char; (Символ "+"}

CharsCount: Word; (Количество символов в шрифте}

Reservl : Byte; (He используется}

FirstChar : Byte; (Код первого символа}

DataOffset: Word; (Смещение до векторных команд первого символа}

FillFlag : Byte; (Флаг заливки}

UpperMargin: Byte; (Высота символов}

Reserv2 : Byte; (He используется}

LowerMargin: Shortint; (Нижняя кромка}

Reserv3 : array [1..5] of Byte end;

THead = array [1..4] of Char;

const

FontList: PFontDesc Bs NIL; (Список шрифтов} FontNumb: Integer = 0; (Количество шрифтов} var

FDesc: TFontDesc;

F: File;

Buf: array [1..128] of Byte; (Заголовок) Head: THead absolute Buf;

FPar: TFontPara; (Параметры шрифта} coast

HeadO: THead = ('P','K',#8,#8);

Function RegisterCHRFile(S: String): Integer;

{Регистрирует векторный шрифт, содержащийся в файле с именем S, и возвращает порядковый номер шрифта} var

k: Integer;

Err: Boolean;

P,PD: PFontDesc;

ParOffs: Word;

Function ReadFile(var Dest; Size: Word): Boolean;

(Читает Size байт из файла F в переменную Dest} begin

BlockRead(F,Dest,Size,k) ;

ReadFile := k=Size end;

{——————}

begin

{Проверяем и корректируем имя} if pos (' . ',S)=0 then S := S+'.chr' ;

(Проверяем по списку, чтобы исключить повторную регистрацию} if FontNurnboO then begin

FDesc := FontList^-with FDesc do

while (NextFontOMIL) and (SOName.FName) do FDesc := MextFont^;

if S=FDesc.Name.PName then

begin (Найден в списке - вернуть номер} RegisterChrFile := FDesc.NFont;

Exit end end;


h0287.htm

(Открываем файл} RegisterChrFile := -1;

Assign (F,S);

{$!-} Reset (F,1);

{$!+} if IQResultOO then

Exit;

{Читаем заголовок} if not ReadFile(Buf,128) then

Exit;

RegisterChrFile := -2;

if HeadoHeadO then

Exit; {Неверный формат файла} (Ищем конец текста} repeat

k := 1;

while (k<=128) and (Buf[k]o$lA) do inc(k);

if )c=129 then

if not ReadFile(Buf,128) then

Exit until But[k]=$lA;

{Позиционируем файл на блок параметров) ParOffs := Buf[k+l]+Buf[k+2] shi 8;

Seek(F,ParOffs) ;

{Читаем параметры}

if not ReadFile(FPar,16) or (FPar.ParPrefix<>'+') then Exit;

{Резервируем память для описателя} RegisterChrFile := -3;

if MaxAvaiKSizeOf(TFontDesc) then

Exit; /Her памяти для регистрации} New(PD) ;

{Формируем новый дескриптор} with PD^FPar do begin

NextFont := Nib;

NFont :- FontNumb+1;

Name.FName := S;

FirstChr := FirstChar;

LastChar := FirstChar+CharsCount-1;

Height := UpperMargin;

Bottom := LowerMargin;

{Читаем таблицу смещений} RegisterChrFile := -1;

Seek(F,ParOffs+DataOffset-3*CharsCount);

if not ReadFile(Offs[FirstChar],2*CharsCount) then begin

Dispose(PD) ;

Exit end;

{Настраиваем смещения) for k := FirstChar to LastChar do

Offs[k] := Offs[k]+ParOffs+DataOffset;

{Формируем таблицу длин} fo» k := PirstChar to LastChar-1 do Leng[k] := Offs[k+1]-Offs[k];


h0288.htm

288____________ ____ __ _________________________Приложение

Leng[LastChar] := FileSize(F)-

Offs[LastChar-1]-ParOffs end;

{Формируем список описателей} if FontNumb=0 then

FontList := PD {Список был пустым} else

begin {Ищем конец списка} Р := FontList; {Начало списка} while P^NextFontONIL do

Р := P^.NextFont; {Next^NIL - конец} P^NextFont :» PD end;

inc(FontNumb)i RegisterChrFile := FontHumb end; {RegisterChrFile} ^_————.———————_

Function RegisterCHRFont(Font: Pointer): Integer;

{Регистрирует векторный шрифт, загруженный в память по адресу Font, и возвращает порядковый номер шрифта}

type

TByte = array [0..65534] of Byte;

var

PH: "THead;

PP: "TFontPara;

PB: "TByte absolute PH;

P,PD: PFontDesc;

k: Integer;

ParOffset: Word;

FileSize: Word;

begin

{Проверяем начало заголовка} PH :° Font;

RegisterChrFont := -Si-if PH^oHeadO then

Exit; {Нет поля 'РК'#8#8} k := 4 у {Ищем CopynghtEnd} while (PB''[k]o$lA) and (k<256) do

inc(k);

if PB^[k]o$lA then

Exit; /Яе нашли терминатор в 256 байтах} {Проверяем блок параметров} ParOffset := РВ^+И+РВ"^-!^] shi 8;

FileSize := PB'^ [k+7]^-PBЛ [k+8] shi 8;

PP :» AddrtPB^[ParOffset]);

if PPA.ParPrefix<>'+^ then

Exit; {Нет префикса параметров} {Резервируем память для описателя} RegisterChrFont :» -3;

if MaxAvail<SizeOf(TFontDesc) then

Exit; /йег памяти для регистрации} New(PD) ;

{Формируем новый дескриптор} with PD^PP^ do

begin

NextFont := 11IL;

NFont := FontNumb+1;

Name.Flag := 0; {Шрифт - в памяти)


h0289.htm

felcdnbi программ_________. , . ________________________289

k := ParOffset+DataOffset;

Name.Addrs.sa :=. segtRB-^k]); {Адрес} Name.Addrs.oa := ofs (PB" [Ic]); [шрифта} FirstChr := FirstChar;

LastChar :=' FirstChar+CharsCount-1;

Height := UpperMargin;

Bottom := LowerMargin;

{Переносим таблицу смещений) k := ParOffset+DataOf?set-3*CharsCount;

Move(PB"W,0ffs[FirstChar],2*CharsCount) ;

{Формируем таблицу длин} for k := FirstChar to LastChar^l do Leng[k] := Offs{k+ll-0ffstk};

Leng[LastChar] := FileSize-Offs[LastChar-1] end;

{Формируем список описателей} if FontNumb^O then

FontList := PD {Список был пустым} else

begin {Ищем конец списка} Р := FontList; {Начало списка} while P^.NextFontONIb do

Р := P^NextFont; {Sext=llIL - конец} P^-NextFont := PD end;

inc(FontNumb) ;

RegisterChrFont := FontNurob end; {RegisterCtirFont} /————————————;

Procedure OutString(S: String; Font: Integer; Angle: Integer; MX,MY: Real);

{Выводит с помощью векторного шрифта Font строку S с поворотом на угол Angle и с масштабными коэффициентами MX,UY) vac

х0,у0: Integer; (Начало очередного символа}

Ang: Real;

Procedure OutChar(var V);

{Выполняет векторные .команды V} var

Vec: array [1. .Maxlnt.1 of Word absolute V;

k,op: Word;

Procedure Coo(X,Y: Integer; var xx,yy: Integer);

{Осуществляет поворот координат X,Y на угол Angle и возвращает новые координаты хх,уу} var

г,a: Single;

begin

{Переводим в полярные координаты}

г :» sqrt(1.0*x*x+1.0*y*y);

if x=0 then if y<0 then 'а :=. -pi/2

else

a := pi/2

else

a := arctan(y/x);

a := a+Ang; {поворот координат}

{Вычисляем новые координаты)

уу := Round(r*sin(a));

хх := Round(r*cos(a)) end; {Coo} <-—"-——;


h0290.htm

var

x, y,xl,yl,xx,yy: Integer;

begin (OutChar) k := 1;

x := xO;

у :- yO;

repeat

op := Vec[k] and $8080;

xx := Vec[k] and $7F;

yy := (Vec[k] shr 8) and $7F» if yy>63 then УУ ••= УУ-128;

{Учитываем масштабные коэффициенты} xx := Round(xx*MX) ;

yy := Round(yy*MY) ;

{Поворачиваем на угол Angle} Coo (xx,yy,xl,yl) ;

xl := xO+xl;

yl := yO-yl;

{Вычерчиваем вектор} if op=$8080 then Line(x,y,xl,yl; ;

{Переходим в новую точку, if opoO then begin

x := xl;

у :° yl end;

{Проверяем конец команд} if op°0 then

begin {Готовим вывод следующего} х0 := x;

yO :- у end else

inc(k) until Op=0 end; (OutChar) {——————}

var

F: File;

k,j: Word;

c: Byte;

Buf: array [1..1OOO] of Word;

P: PFontDesc;

PB: Pointer;

begin {OutString}

(Ищем регистрацию шрифта} if (FontNumb°0) or

(Font>FontNumb) or (S='') then Exit; (Нет ни одного шрифта, пустая

строка или неверный номер шрифта} Р := FontList;

(Переводим угол в радианы} Ang := Angle*pi/180;

for k := 1 to Font-1 do P := P^NextFont;

with P" do begin


h0291.htm

Тексты программ___________________________________________291

if Name.FNameo'' then begin

Assign(F,Name.PName) ;

{$!-} Reset (F,1) ;

{$!+} if IQResultoO then

Exit; (Ошибка доступа к файлу/ end;

х0 := GetX; (Текущие координаты} у 0 := GetY;

for k := 1 to Length(S) do begin

с :- ord(S[k]> ;

if с in [FirstChr..LastChar] then if Name.FNameo'' then

begin (Берем шрифт из файла}

{$!-} Seek(F,Offs [с]) ;

BlockRead(E',Buf,Leng[c] ,j);

{$!+}

if (IOResult=0) and (Leng[c]-j) then OutChar(Buf) end

else (Шрифт загружен в память} with Name.Addrs do begin

PB := ptr(sa,oa+0ffs[c]);

OutCharfPB") end end;

MoveTo(xO,yO) ;

if Name. FNameo' ' then

Close(F) end end; {OutString} ^=,-,»=»-«=.-=; end. {F_Gc'rext} ("=-======»=»=/

ПЗ. РЕДАКТОР ВЕКТОРНЫХ ШРИФТОВ

В этом приложении приводится орисание работы и текст программы, предназначенной для редактирования существующих или создания новых векторных BCI— шрифтов. Такие шрифты используются для вывода текстовых сообщений стандартными процедурами OutText и OutTextXY, а также процедурой OutString из модуля F_GrText в графическом режиме работы экрана. Описание формата BCI— шрифтов приведено в п. 1.2. Программа рассчитана на работу с мышью и экраном типа EGA/VGA.

П3.1. Интерфейс с пользователем

Для запус ка программы следует дать команду

fontedit [FName]

В квадратных скобках указан необязательный параметр, определяющий имя уже существующего CHR— файла.

В момент запуска программа проверяет параметры обращения и, если указано имя FName, настраивается на редактирование шрифта из этого файла. Например, обращение

fontedit trip


h0292.htm

292___________________ ____ ___ __ Приложение

заставит программу загрузить BCI— шрифт из файла trip.chr с целью редактирования стандартного шрифта TriplexFont (добавления новых символов или изменения старых). Вы можете задать имя с предшествующим ему маршрутом поиска CHR — файла на диске (если файл имеет стандартное расширение CHR, это расширение можно не указывать — см. пример выше).

Если параметр обращения отсутствует, программа запрашивает имя файла. В этот момент Вы должны ввести имя, если хотите редактировать шрифт, или нажать Enter, если хотите создать новый.

После правильной загрузки данных из CHR—файла экран приобретет вид, показанный на рис.ШЛ.

Верхняя строка содержит опции меню, левую часть экрана занимает поле редактора, а правую часть — таблица всех символов из редактируемого BGI— шрифта.

Для создания нового или изменения существующего символа используется поле редактора. Это поле расчерчено точками, определяющими локальные координаты символа — любой векторный элемент представляет собой вектор, соединяющий две произвольные точки (два узла) поля редактора. Каждое изменение поля редактора автоматически отображается в уменьшенном виде (точнее, с масштабными коэффициентами 1,1) в небольшом окне повторения ниже поля редактора.

Таблица символов предназначена для выбора очередного символа перед его загрузкой в поле редактора, а также для указания того места в ASCII— таблице, куда будет помещен вновь созданный или отредактированный в этом поле символ. Ниже таблицы создается небольшое окно, в котором показывается ASCII—mop, выбираемого элемента. Так как стандартные векторные шрифты не содержат символов с ASCII— кодами от 0 до 31 и символа #255, соответствующие позиции в таблице заполняются матричными символами шрифта DefaultFont и изображаются пониженной яркостью. При желании Вы можете создать векторный символ для любого ASCII— кода, в том числе и для этих позиций таблицы.

Рис.Ш. 1. Вид экрана редактора шрифтов Опции меню имеют следующий смысл:


h0293.htm

• «Из таблицы» — активизирует выбор из таблицы символа," который требуется загрузить в поле редактора; - '

• «В таблицу» — выбирает то место в таблице ASCII1- кодов, в которое будет ггомвщвй вновь созданный или отредактированный символ; \ "

• «Очистить» -• очищает поле редактора;

• «Образец» — активизирует выбор из таблицы символа, Который будет слухить образцом для вновь разрабатываемого; образец выводится в рабочем поле пониженной яркостью и никак не влияет на новый символ;

• «Сохранить» — сохраняет текущее состояние шрифта в файле;

• «Конец» — завершает работу программы и возвращает управление ДОС; если к этому

моменту в ASCII— таблице были сделаны несохраненные на диске изменения, шрифт

автоматически сохраняется в файле.

Работа программы управляется мышью, две кнопки которой отождествляются со следующими действиями:

• левая кнопка: выбирает продолжение из меню, начинает или заканчивает .формиро-" вание очередного векторного элемента в поле редактора, выбирает текущий элемент в таблице символов;

• правая кнопка: отменяет формирование нового векторного элемента, удаляет (стирает) векторный элемент, отменяет выбор из таблицы символов, перемещает в новое положение правую границу символа в поле редактора.

Для редактирования (изменения) существующего векторного символа выберите- в меню продолжение «Из таблицы», сместите мышью курсор таблицы {белый прямоугольник) к нужному символу и нажмите левую кнопку — поле редактора очистится и в него будет помещена совокупность векторов, определяющих начертание нужного символа. Замечу, что все последующие изменения символа в поле редактора никак не связываются с редактируемом символом до тех пор, пока вновь созданный символ не будет тгомещен на ?го место. Более того, из поля редактора можно переносить новый символ на любое место — таким способом, например, можно быстро заполнить ту часть русского алфавита, которая по наяертанию совпадает с латиницей.

Если Вы хотите создать новый символ, не имеющий сходства с ранее еозданнымйг очистите поле редактора с помощью продолжения «Очистить». Возможно, Ры захотите посмотреть на детали реализации того или иного ранее созданного символа, но не хотите, чтобы его векторы «мешали» вновь создаваемому — в этом случае используйте продолжение «Образец» (например, можно загрузить как образец латинскую букву Р при создании символа

Ф).

Для добавления нового вектора подведите указатель мыши к узлу, от которого он должен начинаться, и нажмите левую кнопку — указатель исчезнет, что сигнализирует о «захвате» узла. Указатель появится вновь только после отпускания кнопки, но будет уже представлять собой небольшой прямоугольник, показывающий границы чувствительности мыши. При перемещении такого указателя по рабочему полю за ним будет тянуться «резиновая нить». В этом состоянии подведите указатель ко второму узлу так, чтобы этот узел попал в прямоугольник указателя, и вновь нажмите левую кнопку — указатель приобретет нормальный вид, а в поле редактора добавится новый вектор. Если Вы передумаете и не захотите добавить вектор, нажмите правую кнопку — «резиновая нить» исчезнет без каких-либо последствий.

Для удаления какого-либо вектора подведите к нему указатель и нажмите правую кнопку. Если мышь спозиционирована достаточно точно, вектор ^удет стерт, а стандартная маска указателя заменится на небольшой прямоугольник. Если теперь, не отпуская кнопки, перемещать указатель в рабочем поле, будут стираться все векторы, на коюрые покажет этот указатель. После отпускания кнопки указатель восстановит стандартный вид и мышь перестанет стирать векторы.

После того, как Вы отредактируете символ нужным образом, выберите в меню продолжение «В таблицу» и поместите символ на нужное место.

На некотором расстоянии справа от символа в поле редактора формируется вертикальная линия, показывающая текущую ширину символа. Положение этой линии автоматически изменяется, если вновь созданный векторный элемент выходит за нее. Вы можете установить положение линии вручную, для этого подведите к ней указатель и нажмите правую кнопку — указатель изменит свой вид на небольшой прямоугольник. В таком состоянии перемещайте мышь, удерживая нажатой ее правую кнопку — линия будет отслеживать горизонтальное


h0294.htm

294________________________________________________Приложение

положение указателя. Перед тем как поместить отредактированный символ в таблицу, Вы должны убедиться в том, что эта линия задает правильный межсимвольный промежуток.

П3.2. Описание программы

Работа программы проходит в три этапа и реализуется процедурами /nit. Run и Done. На этапе выполнения процедуры uii't осуществляются следующие действия:

• вводится имя редактируемого или вновь создаваемого CHR— файла, содержащего нужный векторный шрифт (процедура Namelnputf;

• если файл уже существует, программа проверяет его структуру и считывает данные (процедура ReadData), в противном случае — запрашивает параметры вновь создаваемого файла и готовит его описание (процедура NewFUef;

• переводит экран в графический режим, инициирует мышь и готовит для нее графические указатели, расчерчивает поле редактирования, выводит таблицу символов и готовит меню для работы с мышью (процедура BuildScreenf. Основная работа реализуется процедурой Run. тело которой состоит из бесконечного цикла While True do begin ... end. В ходе этого цикла непрерывно сканируется состояние мыши, и в зависимости от результатов сканирования выполняются следующие действия:

• если мышью выбран один из элементов меню (т.е. указатель подведен к соответствующей надписи и нажата левая кнопка мыши), вызывается одна из процедур GetChar, SetChar, ClearWE, Pattern, SaveFont или Exit в зависимости от сделанного выбора;

• если нажата левая кнопка мыши, а указатель при этом был в поле редактора, вызывается процедура MouseInNed, проверяющая выбор того или иного узла поля редактора; если узел выбран, он становится исходной точкой и от него вслед за указателем мыши будет тянуться «резиновая нить»; если «резиновая нить» уже была сформирована предыдущим обращением к MouseInNed, обращение к этой процедуре вызовет формирование нового векторного элемента редактируемого символа;

• если нажата правая кнопка и указатель располагался в поле редактора, вызывается процедура MouseInLine, проверяющая выбор того или иного вектора и осуществляющая его стирание, если вектор выбран;

• если не нажата ни одна кнопка, но мышь изменила свое положение, будет вызвана процедура MouseMove, реализующая «резиновую нить».

Завершающий этап работы программы реализуется процедурой Done. В ходе ее выполнения вызывается процедура SaveFont для сохранения в файле сделанных изменений, и восстанавливается текстовый режим работы экрана.

В программе используются процедуры и функции из модулей F_GrText (для формирования меню и вывода номера элемента ASCII— таблицы), F_Mouse (для обслуживания мыши и контроля выбора элемента меню) и F_Anti (для автоматической защиты программы от нападения вирусов).

1$Х+} ^——————————————————————————————+

¦ Редактор векторных шрифтов формата CHR ¦

+--------—----—--—-----------—----------——+

;

Uses CRT,Graph,F_GrText,F_Mouse,F Anti;

{

Глобальные определения

}

type

TChar4 = array [1..4] o? Char;

TFontHead = record {Структура заголовка шрифта}

case Byte of

0:(FontFileID: TChar4) ;

1:(B: array [1..128] of byte; ;

end;

TFontPara = record {Блок параметров шрифта}

case Byte of


h0295.htm

Тексты программ__________ _____________ _____ ___________295

ParPrefix : Char; {Символ "+"}

CharsCount: Word; {Количество символов а шрифте}

Reservl : Byte; (He используется)

firstChar : Byte; {Код первого символа}

DataOffset: Word; {Смещение до векторных команд первого -символа}

FillFlag : Byte; (Флаг заливки}

UpperMargin: Byte; {Высота, символов}

Reserv2 : Byte; {He используется}

LowerMargin: Shortint; {Нижняя кромка}

Reserv3 : array [1..5] of Byte?);

1:(H2: array [1..16] of Byte) end;

TOffst = array [0..255] of Word; {Смещения} TWidth = array [0..255] of Byte; {Ширины} TChars = array [0..255] of Pointer; (Данные} TLengD = array [0..255] of Word; {Длина} AW = array [1..255] of Word;

TCooE " record (Векторы рабочего поля}

X1,Y1,X2,X2: Integer;

end;

TMouseMask = array [0..1,0..151 of Word;

var

FontHead TFontHead; {Заголовок файла} HeaderSize: Word; (Смещение блока параметров} FontPara TFontPara; {Параметры шрифта} FileSize Word; {Длина загружаемой части файла} AFileSize: Byte; {Положение FileSize} Offsets TOffst; {Таблица смещений} Widths TWidth; (Таблица ширин} Chars TChars; (Указатели на данные} LengD TLengD; (Длина данных в байтах} F File; {CHR-файл} FName String; {Имя файла} MaxW Byte; {Максимальная ширина символа} MaxH Byte; (Полная высота символа} {——————— рабочее поле ———————}

ХЕ Integer; {Левый верхний угол f/S.} IS Integer;

ХЕ2 Integer; (Правый нижний угод WE) YE2 Integer;

YB Integer; {Ордината базовой линии} WidthX Integer; (Правая граница символа} DXE Integer; {Ширина клетки WE} DYE Integer; {Высота, клетки WE} NVecE Word; {Количество векторов в ИЕ} VecE: array [1..250] of TCooE; {Векторы в ИЕ} (———————— Окно повтора ————————}

XR,YR: Integer; {Координаты окна повтора} HR: Pointer; {Образ пустого окна повтора} {---------- Таблица символов ------------}

XT : Integer; {Левый верхний угол таблица символов} YT : Integer;

DXT : Integer; {Ширина клетки таблицы символов} DYT : Integer; {Высота клетки} {—————————— Мышь -——————————}

dXm,dYm : Integer; {Границы мыши в рабочем поле} CurM: TMouseMask; (Стандартная маска указателя} CurE: TMouseMask; (Маска в рабочем поле} HouseF : Boolean; {Флаг формы указателя мыши}


h0296.htm

const

ChangeF: Boolean '» False; {Флаг изменения шрифта} Head: TChar4 - ('P','К',#8,#8) ;

procedure OutChar(XO,YO: Integer; C: Byte; DX,DY: Real);

(Выводит символ С в позицию X,Y с масштабом DX,DY} var

PW:'-AW;

k: Integer;

x,y: Integer;

Procedure Vector(W: Word);

{Рисует очередной вектор символа} vax

хх,уу: Integer;

ор: Word;

begin

{Выделяем Код операции}

ор := W and $8080;

if op=0 then Exit;

W := H acor ор;

(Выделяем координаты}

уу := W shr 8;

хх := W and $FF;

if xx>63 then xx :•= xx-128;

if yy>63 then yy :•= yy-128;

{Поучаеы координаты второй точки}

хх :=• XO+Round(xx*DX) ;

уу :° YO-Round(yy*DY) ;

{Выполняем операцию}

if op-$8080 then Line(X,Y,XX,YY);

X := XX;

У :« YY end; {Vector} {——————}

begin {OutChar}

if LengD[C]"0 then

Exit; {Блокируем вывод не определенных символов}

YO :" YO-DXT div 4;

X :" ХО; {Точка отсчета координат}

У :° YO;

PW :•=• Chars [С]; (Описатель символа}

{Вычерчиваем символ}

for k :» 1 to LengD[C] div 2 do

Vector (PWik]) end; {OutCharXY} _•————————————;

Procedure ClearWinEd;

{Очищает рабочее поле} var

X,Y: Integer;

begin SetViewPort(XE-dXm,YE-dYm,XE2+dXm,YE2+dYm.True) ;

ClearViewPort;

SetViewPort(0,0,GetMaxX,GetMaxY,True;;

/Выводим вертикали/


h0297.htm

Тексты программ 297

for X := 0 to MaxW do for Y :» 0 to MaxH do

PutPixel(XE+X*DXE,YE+Y*DYE,White);

{Выводим базовую линию}

SetColor(Cyan);

YB := YE+succ(FontPara.UpperMargin)*DYE;

Line(XE,YB,XE2,YB) ;

{Выводим указатель границы символа}

WidthX := ХЕ;

Line(XE,YE,XE,YE2) ;

{Обводим рамкой}

?etColor(White) ;

Rectangle(ХЕ-dXm,YE-dYm,XE2+dXm,YE2+dYm) end; (ClearffE} _•————————————;

Procedure I nit;

{Запрашивает и вводит имя CHR-файла, вводит данные из файла, инициирует--гря~ фику и создает экран}

Procedure FontRsad. (var Dest; Size: Word);

(Читает из файла F в переменную Dest Size байР я контролирует результат. При ошибке аварийно завершает программу} var

k: Word;

begin

BlockRead(F,Dest,Size,k) ;

if k=Size then Exit;

WriteLnCОшибка при чтении данных из файла!');

Halt end; (FontRead) {—————} Procedure NameInput(var FName: String);

(Вводит и проверяет имя CHR-файла} label

Loop,HeadErr;

var

k: Byte;

begin

Write('Программа редактирования векторных BQI-шрифтов формата CHR. ') ;, WriteLn('<C) 1993 В.В.Фаронов') ;

{Проверяем параметры обращения} if ParamCountoO then

FName := ParamStr(l) else

FName := '';

if FName='' then

begin Loop: (Сюда возврат при ошибке в имени}

Write('Введите имя CHR-файла (*.CHR): ');

ReadLntFName) ;

it FName = ' ' then

begin {Пустой ввод} Write('Создать новый шрифт (Y/N)? ');

ReadLntFMame);

if (FName=") or

(UpCase(FName[1])<>'Y') then Halt;

FName :° '';

Exit


h0298.htm

end end;

{Проверяем существование файла) if Pos('.',FName)=0 then FMame := FName+'.CHR' ;

{$!-} {Отключаем контроль lOEtrorf Assign(F,FName);

Reset(F,1); {Пытаемся открыть файл} {$!+} {Восстанавливаем контроль ЮЕггог} if IQResultoO then begin

WriteLn('Файл '+FName+' не найден');

Goto Loop end;

{Читаем заголовок файла} FontRead(FontHead,SizeOf(FontHead)) ;

if FontHead. FontFileIDoHead then begin

WriteLn('Ошибка в заголовке файла!');

Goto Loop end;

{Ищем смещение блока параметров и длину файла'} with FontHead do begin

k := 5; {Начинаем с пятого байта} while (kOizedf (FontHead)) and (B[k]o$lA) do inc(k);

if B[k]=$lA then begin

HeaaerSize := B[k+l]+B[k+2] ehl 8;

FileSize := B[k+7]+B[k+8] ahl 8;

AFileSize := k+7;

{Читаем блок параметров} Seek(F,HeaderSize) ;

FontRead(FontPara,SizeOf(FontPara)) ;

if FontPara.ParPrefix='+' then

Exit {Нормальный выход) else /Her префикса параметров}

Goto HeadErr end end;

{Не найден терминатор CopycightEnd) HeadErr:

Close(F) ;

WriteLn('Ошибка в заголовке файла!');

Goto Loop end; {Каше Input} {—————} Procedure ReadData;

{Читает данные из файла} var

k: Integer;

LastChar: Byte;

begin

with FontPara do begin

LastChar := FirstChar+CharsCount-1;

{Заполняем таблицу смещений} for k := 0 to 255 do

if k in [FirstChar..LastChar] than


h0299.htm

Тексты программ ___ ______ _______ _„..„_. 299

FontRead(Off sets[k],2) else

Offsets[k] := 0;

{Заполняем таблицу ширин) MaxW := 0;

for k := 0 to 255 do

if k in [FirstChar..LastChar] then begin

FontRead(Widths[k],1) ;

if Widths[k]>MaxW then

MaxW := Widths(k] end else

Widths[k] :" 0;

if MaxW<20 then MaxW := 20;

{Готовим память и считываем данные) for k := 0 to 255 do

LengD[k] := 0; (Обнуляем таблицу длин} for k := FirstChar to LastChar do begin

if k=LastChar then

LengD[k] := FileSize-Offsets[k]-FontPara.DataOffset

else

LengD(k] := Offsets[k+1]-Off sets[k];

if LengD[k]<>0 then begin

GetMem(Chars[k],LengD[k]) ;

FontRead(Chars[k]",LengD[k]) end end;

Close(F) ;

end; {with FontData) end; {ReadData} f—————} Procedure BuildScreen;

{Переводит дисплей а графический реяшм, вычисляет константы и создает экран)

procedure PutCur(var Cur: TMouseMask) ;

{Сканирует изображение в левом верхнем углу экрана и формирует маску указателя мыши} var

х,у: Byte;

b: Word;

begin

for у := 0 to 15 do begin b :° 0;

for x := 0 to 15 do

if GetPixel (x, y) OGetBkColor then b := b or ($8000 shr x) ;

Cur[l,y] := b;

Cur[0,y] := not b end end; {PutCLir} {—————} var

D,R,E,k,n,X,Y: Integer;


h0300.htm

с: Byte;

S: String;

Sz: Word;

FF: File;

Font: Pointer;

const

Txt: array [1..6] of String [10]=(

•Из таблицы', 'В таблицу', 'Очистить', 'Образец', 'Сохранить', 'Конец');

Items: array [1..6] of MouseItemType=(

(X1:1 ; Y1:1; X2:13; 12:2; Butt: LeftButton; Key 1 ehl 8), (X1:14; Y1:1; X2:25; Y2:2; Butt: LeftButton; Key 2 shi 8), (XI:26; Y1:1; X2:37; Y2:2; Butt: LeEtButton; Key 3 shi 8), (X1:38; Y1:1; X2:49; Y2:2; Butt: LeftButton; Key 4 shi 8), (X1:50; Y1:1; X2:61; Y2:2; Butt: •LeftButton; Key 5 shi 8), (X1:61; Y1:1; X2:80; Y2:2; „Butt: beftButton; Key 6 shi 8));

begin {BuildScreen)

{Переходим в графику}

D := Detect; {Автоопределение драйвера I

InitGraph(D,R,''); (Инициируем графику}

Е :=• GraphResult; {Проверяем результат}

if EoO then

begin {Есть ошибка} WriteLn(GraphErrorMsg(Б));

Halt end;

{Выбираем шрифт а зависимости от разрешения экрана}

case GetMaxY of

199: с := S; {CGA 8х8} 349: с := 14; {EGA 8х14} 479..1024: с := 19; {VGA,SVGA 8х19}

else

с := 8 {Прочие 8х8}

end;

with FontPara do

MaxH := UpperMargin-LowerMargin+1;

{Определяем границы рабочего поля}

DYE = succ(GetMaxY) div (5*MaxH div 4); (Высота клетки}

DXE = succ(GetMaxX) div (2*MaxW); {Ширина клетки}

XE = DXE div 3; (Смещение слева}

YE = 2*с; (Смещение сверху}

ХЕ2 = XE+MaxW*DXE; (Правый нижний угол}

YE2 = YE+MaxH*DYE;

(Определяем размеры указателя мыши в рабочем поле и формируем его маски}

dXm = XE;

dYm = DYE div 3;

(Проверяем наличие мыши}

if not InitMouse then

begin (Нет мыши - завершаем работу} CloseGraph;

WriteLn('Нет мыши - программа не может работать');

Halt end;

(Готовим стандартный указатель}

ShowMouse;

MouseGotoXY(0,0); (В левый верхний угол}

PutCur(CurM); (Получить образ}

HideMouse;

(Указатель-квадратик для рабочего поля}

Rectangle(0,0,2*dXm,2*dXm);


h0301.htm

Тексты программ ДО/

PutCur(CurE); {Подучить образ}

{Расчерчиваем рабочее поле}

ClearWinEd;

fГотовим координаты окна повторения символа} XR :=(XE2-XE) div 2;

YR := GetMaxY-MaxH;

sz := ImageSize(XR,YR,XR+MaxW,YR+MaxH);

GetMem(WR,sz) ;

Getlmage (XR^R^R+MaxW^R+MaxH.WR*);

{Создаем таблицу символов)

XT :- XE+(MaxW+l)*DXE; {Левый верхний} YT :== YE; {угол таблицы символов} DXT := GetMaxX div 32; {Шаг по горизонту} DYT := GetMaxY div 20; {Шаг по вертикали} SetColor(White); /Белый цвет;

for n := 0 to 255 do /'Выводим символы} with FontPara do begin

X :» XT+(n mod 16)*DXT;

Y :" YT+(n div 16)*DYT;

if LengD[n]<>0 then begin

SetColor(White) ;

OutChar(X,Y+DYT,n,DXT/MaxW,DYT/(MaxH+5)) end •Xse

begin [Выводим недостающие символы} SetColor(DarkGray);

OutTextXY(X,Y+DYT-8,Chr(n)) end end;

{Загружаем шрифт из файла SxH.fntf Str(c,S);

S := '8x'+S+'.fnt';

Assign(FF,S) ;

{$!-} Reset (FF,1);

{$!+} if lOResultoO then begin

CloseGraph;

WriteLnCHer шрифтового файла '+S);

Halt end;

Sz := System.FileSize(FF);

GetMem(Font,Sz);

BlockRead(FF,Font",Sz,r) ;

Close(FF) ;

if rOSz then begin

CloseGraph;

WriteLn('Ошибка чтения файла '+S);

Halt end;

{Регистрируем шрифт и переназначаем ввод/вывод} SetFont(Font,8,с) ;

GraphWriteOn;

(Выводим строку меню} ' Colors(Black,LightGray) ;

for k := 1 to 6 do with Items[k] do


h0302.htm

302 Приложение

SetWindow(XI,Y1,X2,Y2-1,EmptyBorder,Txt[k],False,False,False);

{Инициируем мышь} SetMouseItem(6,Items);

ShowMouse; {Показывав» указатель тшши} TextRatioY := с;

end; (BulldScreen} {—————} Procedure NewFile(var FName: String);

{Создает новый CHR-файл} var

Name: String;

HH: ShortInt;

H,k: Byte;

Y: String [1] ;

const

tl='Максимальная высота символов от базовой линии: ';

t2='Расстояние до нижней кромки символа: ';

13"'Максимальная ширина: ';

t4=" font VI.1 Jan 12, 1989';

t5=#13#10;

t6='Copyright (c) 1987,1988 Borland International';

begin

(Вводим в диалоге параметры шрифта} repeat

Write('Введите 4-буквенное имя шрифта: ':55);

ReadLn(Name);

while Length(Name)<4 do Name := Name+'0';

Name[0] := chr(4) ;

for k := 1 to 4 do

Name[k] := UpCase(Name[k]);

Write(tl:55) ;

ReadLn(H) ;

H :° H and 63;

Write (t2:55) ;

ReadLn(HH) ;

if HH>0 then HH :- -HH;

Write(t3:55) ;

ReadLn(MaxW) ;

MaxW := MaxW and 63;

MaxH := H-HH;

WriteLn;

WriteLn('Будет создан шрифт с именем '+

Name+' со следующими параметрами:');

WriteLn(tl:55,H);

WriteLn(t2:55,HH) ;

WriteLn(t3:55,MaxW) ;

Write('Согласны (Y/N, умлч.У)? ');

ReadLn(У) ;

until (Y<>") or (UpCase(Y[l])<>'N') ;

{Готовим заголовок} for k := 1 to 128 do

FontHead.B[k] := 0;

for k := 1 to 16 do

FontPara.H2[k] := 0;

FName :» Name+'.CHR';

with FontHead do

begin

FontFileID := Head;


h0303.htm

Тексты Программ 303

Name := 'BGI 4-Name+t4+t5+t6+t5+#0;

for k := 1 to Length(Name) do B[k+4] := ord(Name[k]);

AFileSize :" k+12;

Name := #$80#0+FName;

Name[0] := #$1A; {CopyrightEndl Name[7] := #0; {LolfileSise]} Name[8] := #0; {Hl[FileSizeJ} Name[9] :- *1; {VI.) Name[10] :- #0;

Name[11] := #1; (V.I} for k := 0 to 11 do

B[AFileSi2e-7+k] :- ord(Name[k]) ;

end;

{Готовим Блок параметров} with FontPara do begin

ParPrefix :" '+';

CharsCount :=° 0;

FirstChar :» 0;

DataOffset := 16;

FillFlag := 0;

UpperMargin := H;

LowerMargin := HH end;

{Готовим таблицу длин} for k :- 0 to 255 do LengD[k] := 0;

Assign(F,FName) end;

(—————} begin {Init} repeat

Namelnput(FName); {Вводим и контролируем имя файла} it FNameoI' then

ReadData {Читаеи данные из файла/ else

NewFile(FName) {Создаем новый файл} until FNameo'';

BuildScreen {Создаем экран} end; {Init} /————————————^

Procedure SaveFont;

{Сохраняет шрифт в файле} Procedure Alarm;

{Сообщает об ошибке записи} •чах

X2,Y2,X1,Y1: Integer;

Sz: Word;

P: Pointer;

С: Char;

begin

HideMouse;

Colors(White,Red) ;

Window(15,12,65,14) ;

GetWindGraphCoo(Xl,Yl,X2,Y2) ;

Sz := ImageSize(Xl,Yl,X2,Y2) ;

GetImage(Xl,Yl,X2,Y2,PЛ);

SetWindow(15,12,65,14,2,' Нажмите любую клавишу ',True,True,True);

Write('Ошибка доступа к файлу!':37);


h0304.htm

ShowMouse;

while not KeyPressed or not MousePressed do;

while KeyPressed do С := ReadKey;

While MousePressed do;

HideMouse;

PutImagetX^Y^P^NormalPut) ;

ShowMouse;

FreeMem(P,Sz) end; {Alarm} {——————}

Function WriteFile(var Source; S: Word): Boolean;

{Записывает в файл S байт из переменной Source и контролирует результат} var

k: Word;

begin

BlockWrite(F,Source,S,k) ;

WriteFile := S»k;

if Sok then

Alarm end;

/——————;

var

k: Integer;

MinChr,MaxChr: Byte;

W,Offs,PredO: Word;

begin

if not ChangeF then Exit;

{Определяем начальный символ} MinChr := 0;

while (MinChr<255) and (LengD[MinChr]=0) do inc(MinChr) ;

if MinChr=255 then Exit;

(Определяем последний символом} MaxChr := MinChr;

k := MaxChr;

while k<-255 do begin

if LengD[k]<>0 then MaxChr := k;

inc(k) end;

{Корректируем пустые символы к подсчитываем длину загружаемой части} FileSize := 0;

for k := MinChr to MaxChr do if LengD[k]-0 then

begin {Пустой символ) Widths[k] := Widths[MinChr] ;

inc(FileSize,LengD[MinChr]) end else

inc(FileSize,LengD[k]) ;

{Определяем смещение в файле) Offs := 3*(MaxChr-MinChr+l)+16;

(Корректируем описатель шрифта) with FontPara do begin


h0305.htm

Тексты программ __________ -w>

FirstChar :- MinChr;

CharsCount:» MaxChr-MinChr+1;

Data0ffset:= Offs;

FileSize :» FileSize+16+3*CharsCount end;

{Записываем заголовок} With FontHead do begin

B[AFileSize] :° Lo(FileSize) ;

B[AFileSize+l] :-Hi(FileSize) end;

{Готовим файл} {SI-} Rewrite(F,1) ;

($!+} if IQResultoO then begin Alarm;

Exit end;

if not WriteFile(FontHead,SizeOf(FontHead)) then Exit;

{Записываем описатель)

if not WriteFile(FontPara,SizeOf(FontPara)) then Exit;

{Записываем таблицу смещений) PredO := Offs;

for k :» MinChr to MaxChr do begin

W := Offs-PredO;

if LengD(k]<>0 then

inc(0?fs,LengD[k]) else

inc(Offs,LengD[MinChr]) ;

if not WriteFile(W,2) theo

Exit end;

{Записываем таблицу ширин) for k := MinChr to MaxChr do

if not WriteFile(Widths[k],l) then Exit;

{Записываем данные) for k := MinChr •to MaxChr do if LengD[k]<>0 then

if not WriteFile (Chars [It]*, LengD[k]) then

Exit else else

if not WriteFile(Charstk]",LengD[MinChr]) then Exit;

Close(F); (Все в порядке) ChangeF := False Mid; {SaveFont} ^——————.—————;

Procedure Run;

{Основная работа: чтение мыши или клавиатуры и вызов нужных процедур}

•VAX

BM,XM,YM,B,X,Y: Integer;

x0g,y0g,xlg,ylg: Integer; {Координаты резиновой нити} MPF: Boolean; (Флаг резиновой нити}


h0306.htm

PW^AW;

W,op: Word;

Procedure RepChar;

{Повторяет символ в окне повтора} var

k: Word;

begin

{Стираем старое изображение}

PutIniagetXI^YR.WR-^NormalPut) ;

{Формируем новое}

SetWriteMode(NormalPut) ;

SetColor(White) ;

for k := 1 to NVecE do with VecE[k],FontPara do

Line(XR+Xl div DXE,YR+MaxH+LowerMargin-(YB-Y1) div DYE,XR+X2 div DXE, YR+MaxH+LowerMargin-(YB-Y2) div DYE);

end;

{——————}

Function Tabi(var N: Byte): Boolean;

{Выбирает символ из таблицы. Возвращает номер символа или False для правой кнопки} var

X,Y, k,xx,yy,ddx,ddy: Integer;

NX,NY,NXX,NYY: Byte;

Sz: Word;

P: Pointer;

begin

HideMouse;

ddx :" DXT div 2; {Половина ширины}

day :" DYT div 2; {Половина высоты)

X :« XT+ddx; /'Начальный символ)

У :- YT+ddy;

NX :- 0; {Номер столбца)

NY :« 0; {Номер строки)

MouseGotoXy(X,Y) ;

MouseWindow(X,y,X+16*DXT,Y+16*DyT);

{Выделяем символ)

Sz :- ImageSize(X-ddx,Y-ddx,X+ddx,Y+ddx) ;

GetMem(P,sz);

Getlmage(X-ddx,Y-ddy,X+ddx,X+ddy,P*) ;

PutImage(X-ddx,Y-ddy,PA,NotPut) ;

while MousePressed do; ^Сбрасываем кнопку)

{Перемещаемся по таблице до нажатия на кнопку мыши}

while not MousePressed do begin

GetMouseState(k,xx,yy); {Текущее положение} NXX := (xx-XT) div DXT,-NYY := (yy-YI) div DYT;

if (NXONXX) or (NYONYY) then

begin {Перешли в новую клетку} Putlmage(X-ddx,Y-ddy,P",NormalPut) ;

Window(l,l,80,25);

GotoXY(60,25) ;

TextColor(White) ;

TextBackGround(LightRed);

Write(NYY*16+NXX:4,' ');

NX :== NXX;

NY := NYY;

X :» XT+NX*DXT+ddx;

У :« YT+NY*DYT+ddy;

Getlmage(X-ddx,Y-ddy,X+ddx,Y+ddy,P^ ;


h0307.htm

Тексты программ __ 307

Putlmage(X-ddx,Y-ddy,P^,NotPut) ;

end end;

(Нажата кнопка: восстанавливаем экран} Putlmage (X-ddx,Y-ddy,P'',MormalPut);

FreeMem(P,sz);

GotoXY(60,25) ;

Write (' ') ;

GetMouseState(k,xx,yy); {k - нажатая кнопка) while MousePressed do; {Ждем отпускания} N := NY*16+NX;

Tab! := k=LeftButton;

ShowMouse;

MouseScreen (Освобождаем мышь} end; {Tab!} {——————}

Procedure ClearWE;

{Очищает рабочее поле} begin

ClearWinEd;

Putlmage (XR.YI^WR^NormalPut:) ;

NVecE := 0;

WidthX := 0 end;

{——————}

Procedure GetChar;

(Берет символ из таблицы} var

k: Integer;

N: Byte;

W,op: Word;

xx,yy: Shortint;

begin

if not Tab!(N) then

Exit; {Выход по правой кнопке} ClearWE; (Очищаем рабочее поле} PW := Chars[N]; (Адрес описателей} X := 0; (Начальные координаты пера} У := 0;

SetColor(Yellow) ;

SetWriteMode(XORPut) ;

(Цикл по командам} for k := 1 to LengD[N] div 2 do begin

H := PW[k]; (Очередное слово} op := W and $8080; {Код операции} W := W xor op;

xx := W and 127; (Координата Х} yy :=• W shr 8; {Координата Y} if yy>63 then yy := yy-128;

if op=$8080 then

begin (Команда чертить} inc(NVecE); (Колич.векторов} with VecE[NVecE] do

begin (Формируем новый вектор} XI := XE+X*DXE;

Yl :- YB-Y*DYE;

X2 := XE+xx*DXE;


h0308.htm

308_____________________________________________Приложение

Y2 := YB-yy*DYE;

{Чертим линию в рабочей поле) Line(Xl,Yl,X2,Y2) end;

end;

X := хх; {Новое положение пера) Y :- уу end;

(Чертим правую границу символа} WidthX := XE+Widths[N]*DXE;

SetColor(Cyan) ;

Line(WidthX,YE,WidthX,YE2) ;

{Повторяем символ в окне повтора} RepChar end; {GetChar} {——————}

Procedure SetChar;

{Помещает символ в таблицу} var

k: Integer;

N: Byte;

W,op: Word;

Data: AW;

X,Y,XX1,YY1,XX2,YY2: Shortint;

Xc,Yc: Integers-begin

if not Tabl(N) then Exit;

{Удаляем старый описатель} if LengD[N]<>0 then

FreeMem(Chars[N],LengD[N]);

Widths[N] :«= (WidthX-XE) div DXE;

LengD[N] :" 0;

{Цикл по векторам} X :° 0;

Y :- 0;

for k :- 1 to NVecE do with VecE[k] do begin

XXI := (Xl-XE) div DXE;

XX2 := (X2-XE) div DXE;

YY1 := (YB-Y1) div DYE;

YY2 := (YB-Y2) div DYE;

if (xoxxi) or (YOYYI) then begin {команда перехода} if YYKO then inc(YYl,128) ;

inc(LengD[N]) ;

Data[LengD[N]] :« YYl «Ы 8+ХХ1 or $80 end;

X := XX2;

Y :•= YY2;

if YY2<0 then inc(YY2,128);

inc(LengD[N]) ;

Data[LengD[N]] :- YY2 ahl 8+XX2 or $8080;

end;

{Формируем переход в конец символа} inc (LengD [N]) ;

Data[LengD[N]] :- Widths[N] or $80;


h0309.htm

inc(LengD[N]) ;

Data[LengD[N]] :» 0; {Конец команд) {Записываем в память} LengD[N] :-2*LengD[N];

GetMem(Chars[N],LengD[N] ) ;

Move(Data,CharstN]",LengC[N]) ;

{Чертим символ в таблице} HideMouse;

Хс := XT+(N mod 16)*DXT;

Yc := YT+(N div 16)*DYT;

SetFillStyle(SolidFill,Black) ;

Bar(Xc,Yc,Xc+DXT-l,Yc+DYT-l);

SetColor(White) ;

SetWriteMode(NormalPut) ;

OutChar(Xc,Yc+DYT,N,DXT/MaxW,DXT/(MaxH+5)) ;

SetColor(Yellow) ;

SetWriteMode(XORPut) ;

ShowMouse;

ChangeF := True end; {SetChar} {——————}

function Nedfvar x,y: Integer): Boolean;

(Возвращает TRUE и координаты узла, если мышь попала в его окрестности} var

Is: Boolean;

begin

Is := False;

у := YE;

repeat

X := XE;

repeat

Is := MouseIn(x-dXm,y-dYm,x+dXin,y+dYm);

if not Is then

inc(x,DXE) until Is or (x>XE2);

if not Is then

inc(y,DYE) until Is or (y>YE2) ;

Ned := Is end; {Ned} {——————}

Procedure MouseInNed;

{Проверяет отметку мышью узла сетки} var

XM,YN: Integer;

begin

if not Ned(XN,YN) then

Exit; /Яе попали в узел} HideMouse;

while MousePressed do;

MouseGotoXY(XN,YN) ;

if not MPF then

begin /Запоминаем узел} MPF := True;

XOg := XN;

YOg := YN;

Xlg := XOg Ylg :- YOg;

SetColor(Yellow) ;

SetWriteMode(XORPut);


h0310.htm

310 ______ ____ _____ _____ Приложение

MouseWindow(XE,YE,XE2,YE2) ;

MouseGraphCursor(CurE» dXm,dYm);

ShowMouse and else

begin (Формируем новый вектор! MPF := False;

if (xOgOxlg) or (yOgOylg) then Line(xOg,yOg,xlg,ylg) ;

MouseScreen;

it (XOgoXN) or (YOgoYN) then

begin (Поиещаем очередной вектор} inc(NVecE) ;

with VecE[NVecE] do begin

XI :° XOg;

Yl := YOg;

X2 := XN;

Y2 :- YN;

Lir)e(xl,yl,x2,y2);

RepChar end;

{Проверяем ширину символа^ if XOg>XN then XN := XOg;

if XN>WidthX then

begin {Смещаем правую границу} SetColor(Cyan) ;

SetWriteMode(XORPut) ;

Line(WidthX,YE,WidthX,YE2) ;

WidthX := XN+4*DXE;

if WidthX>XE2 then WidthX := XE2;

Line(WidthX,YE,WidthX,YE2) ;

SetColor(Yellow) ;

end;

MouseGraphCursor(CurM,0,0);

ShowMouse end end

end; {MouseInNed} {——————}

Procedure MouseInLine;

(Проверяет отметку вектора} var

х1т,у1я,х2т,у2т,dx,dy,x,y,n: Integer;

Is,Sign: Boolean;

k: Word;

k0,y0: Real;

label Loop;

begin

if MPF then

begin {Уничтожаем резиновую нить} HideMouse;

MPF := False;

if (XOgoXlg) or (YOgoYlg) then Line(XOg,YOg,Xlg,Ylg) ;

MouseGraphCursor(CurM,0,0);


h0311.htm

ShowMouse;

MouseScreen;

Exit end;

if NVecE-0 then

Exit; {Пустое рабочее поле} Loop:

GetMouseState(x,xlm,ylm) ;

if (not MousePressed) and MouseF then begin

HideMouse;

MouseGraphCursor(CurM,0,0);

ShowMouse;

MouseScreen;

MouseF :" False;

Exit end;

x2m := xlm+dXm;

y2m := ylm+dYm;

xlm := xlm-dXm;

ylm := ylm-dYm;

{Проверяем все векторы} n := 1;

Is :a= False;

repeat

with VecE[n] do if (xl=x2) and (xl>=xlm) and (xl<=x2m) then {Вертикальный вектор}

Is := ((yl>=y2m) and (y2<=ylm)) or ((yl<=ylm) and (y2>=y2m)) else if (yl=y2) and (yl>=ylm) and (yl<=y2m) -then (Горизонтальный вектор}

Is := ((xl>=xlm) and (x2<=x2m)) or ( (xl<=x2m) and (x2>»-xlm)) else {Наклонный вектор} if (((yl>=y2m) and (y2<=ylm)) or ((yl<=ylm) and (y2>=y2m))) and (((xl>=xlm) and (x2<»St2m)) or ((xl<=x2m) and (x2>=xlm))) then begin

kO := (y2-yl)/(x2-xl);

yO := yl-k0*xl;

for x := xlm to x2m do if not Is then begin

у := Round(k0*x+y0) ;

Is := (y>=ylm) and (y<»y2m) ;

if not Is then if x=xlm then

Sign := y<ylm else

Is:= (Sign and (y>ylm)) or (not Sign and (y<ylm)) end end;

if not Is then

inc(n) until Is or (n>NVecE) ;

if Is then

begin {Удаляем вектор! HideMouse;

SetColor(Yellow) ;

SetHriteMode(XORPut) ;

with VecE[N) do

Line(xl,yl,x2,y2); /Стираем линию}


h0312.htm

3f3_________________________ ___________________Приложение

if NVecE>l then {Перемещаем векторы} for N :- N to NVecE-1 do VecE[N] := VecEtN+1];

dec(NVecE) ;

RepChar;

it NVecE>l then begin

MouseGraphCursor(CurE,dXm,dYm);

MouseWindow(XE-dXm,YE-dYm,XE2+dXm,YE2+dYm) ;

MouseF :° True end else begin

MouseGraphCursor(CurM,0,0);

MouseScreen;

MouseF := False end;

ShowMouse;

it MouseF then

Goto Loop end else if MouseF then

Goto Loop els» if (WidthX>-xlm) and (WidthX<"x2m) then

begin {Перемещаем правую границу} SetColor(Cyan) ;

SetWriteMode(XORPut);

HideMouse;

MouseGraphCursor(CurE,dXm,dYm);

ShowMouse;

MouseWindow(XE,YE,XE2,YE2) ;

while MousePressed do begin

GetMouseStste(n,xlm,ylm);

if XE+DXE*Round((xlm-XE)/DXE)<>WidtbX then begin

HideMouse;

Line(WidthX,YE,WidthX,YE2) ;

WidthX := XE+DXE*Round((xlm-XE)/DXE) ;

Line(WidthX,YE,WidthX,YE2) ;

ShowMouse end end;

MouseScreen;

HideMouse;

MouseGraphCursor(CurM,Q, 0) ;

ShowMouse and end;

{——————}

Procedure MouseMove;

{Контролирует перемещение мыши} begin

if MPF and ( (XMoXlg) or (YMOYlg)) then

begin {Формируем резиновую нить) HideMouse;

if (XOgOXlg) or (YOgOYlg) then

Line(XOg,YOg,Xlg,Ylg); {Стираем старую}

Xlg := XM; (Новые координаты конца}


h0313.htm

Ylg := YM;

if (XOgoXlg) or (YOgOYlg) then Line (XOg,YOg,Xlg, Ylg) ;

ShowMouse end;

end; {MouseMove} {——————}

Procedure Pattern;

{Выбирает и помещает в рабочее поле образец} var X,Y,xx,yy: Integer;

k,op,W: Word;

PW^AW;

N: Byte;

begin

if not Tabi(N) than

Exit; (Выход по правой кнопке} SetColor(LightGray) ;

PW := Chars[N]; {Адрес описателей} X := XE; (Начальные координаты пера} У := YB;

{Цикл по командам} for k := 1 to LengD[N] div 2 do begin

H := PW^I-k]; (Очередное слово} ор := H and $8080; (Код операции) W := W acor op;

xx := W and 127; {Координата Х} yy := W shr 8y {Координата Y) if yy>63 then УУ ••= УУ-128;

xx :- XE+xx*DXE;

yy := YB-yy*DYE;

if op-$8080 then Line (X, У, xoc, yy) ;

X := xx; {Новое положение пера} Y := yy end;

SetColor(Yellow) end;

/—————;

begin {Run}

SetWriteMode(XORPut) ;

NVecE :•= 0; (Нет векторов в WE} MPF := False; {Мышь не нажималась} SetColor(Yellow) ;

GetMouseState(BM,XM,YM); (Начальное состояние ыыши} While True do /Бесконечный цикл до команды "Конец" } begin

{Проверяем выбор меню и клавиатуру} if KeyOrMousePressed then case ReadKeyOrMouse of

#0: case ReadKeyOrMouse of

#1 GetChar;

#2 SetChar;

#3 ClearWE;

#4 Pattern;

#5 Savefont;

#6 Exit;


h0314.htm

end;

end;

{Проверяем текущее состояние мыши} GetMouseState(В,X,Y) ;

if (BOBM) or (XOXM) or (YOYM) then if MousePressed and

MouseIn(XE,YE,XE2,YE2) then

case В of {Контролируем кнопки} LeftButton :MouseInNed;

RightButton:MouseInLine;

end

else {Контролируем перемещение} MouseMove;

XM :» X;

YM := Y;

BM := В end end; {Run}

Procedure Done;

begin

SaveFont;

CloseGraph;

end; (Done} _•-————————————;

begin {Главная программа}

Init; {Инициация шрифта и экрана}

Run; {Редактирование или создание символов}

Done (Завершение работы}

end.

П4. МОДУЛЬ FJMSK ДЛЯ РАБОТЫ С ДИСКОМ НА ФИЗИЧЕСКОМ УРОВНЕ

Описание модуля см. п.3.3.

/..-»—=..=»==,===^ OHIT F_Disk; ^=-===~-====-^

{

+—————————————————————————————————————+

I Модуль содержит подпрограммы для гибкой работы с дисками. I I Во всех подпрограммах параметр DISK относится к логическим I I дискам: 0=А, 1=В, 2=С, 3=0 и т.д. Параметр SEC - относи- I I тельный номер сектора: О •s загрузочный сектор, далее по I

секторам до конца дорожки, по головкам, по цилиндрам. 1 +---__--_------_------__-------------------------------------+

;

INTERFACE type

{Информация из ВРВ загрузочного сектора:}

ВРВ_Туре = record

SectSiz : Word; {Количество байт в секторе}

ClustSiz: Byte; {Количество секторов в кластере.

ResSecs : Word; {Количество секторов перед FAT}

FatCnt : Byte; (Количество FAT}

RootSiz : Word; (Количество элементов корневого каталога}

TotSecs : Word; {Количество секторов на диске}

Media : Byte; {Дескриптор носителя}

FatSize : Word {Количество секторов в FAT}

end; {BPB_Type}


h0315.htm

(Дополнительная информация из загрузочного сектора:} Add_BPB_Type = record

TrkSecs : Word; {Количество секторов на дорожке

для разделов меньше 32 Мбайт или 0}

HeadCnt : Word; (Количество головок}

HidnSecLo: Word; (Количестве спрятанных секторов для разделов меньше 32 Мбайт}

HidnSecHi: Word; (Вместе в HidnSecLo дает количество

спрятанных секторов для разделов больше 32 Мбайт}

LargSectors: Longint; (Общее количество секторов для

разделов больше 32 Мбайт} end; {Add_BPB_Type} {Элемент дискового каталога:} Dir_Type ° record caae Byte of 1: (

Name : arxay [1..8] of Char; (Имя файла или каталога)

Ext : array [1..3] of Char; {Расширение}

FAttr : Byte; (Атрибуты файла}

Reserv: arxay [1..10] of Byte; {Резервное поле}

Time : Word; {Время создания}

Date : Word; {Дата создания}

FirstC: Word; (Номер первого кластера}

Size : Longint {Размер файла в байтах});

2:(NameExt: array [1..11] of Char) end; (Dir_Type}

(Описатель логического раздела} PartType = record

Act: Boolean; (Флаг активности раздела}

BegHead: Byte; (Головка начала раздела}

BegSC : Word; (Сектор/цилиндр начала}

SysCode: Byte; {Системный код}

EndHead: Byte; (Головка конца раздела}

EndSC : Word; (Сектор/цилиндр конца}

RelSect: Longint; (Относительный сектор начала}

FoolSiz: Longint (Объем в секторах} end; {PartType} (Загрузочный сектор диска} PBoot = "TBoot;

TBoot = record case Byte of 0: (

a : array [1..11] of Byte;

BPB: BPB Type;

Add: Add_BPB_Type;

с : array [1..+$1BE-(SizeOf(BPB_Type)+SizeOf(Add_BPB_Type)+11)] of Byte;

Par: array [1..4] of PartType);

1: (b: array [1..512] of Byte) and;

(Описатель диска по структуре lOCTtf !OCTL_Type = xecord

BuildBPB Boolean; (Строить BPB}

TypeDrv Byte; (Тип диска}

Attrib Word; (Атрибуты диска}

Cylindrs Word; (Число цилиндров}

Media Byte; (Тип носителя}

BPB BPB_Type;

Add Add_BPB_Type;

Reserv array [1..10] of Byte;

end;


h0316.htm

{Описатель диска! TDisk = record

Number Byte; {Номер диска 0°Л,...}

TypeD Byte; {Тип диска}

AttrD Word; {Атрибуты диске}

Cyls Word; (Число цилиндров на диске)

Media Byte; (Дескриптор носителя)

SectSize Word; (Количество байт в секторе}

TracltSiz Word; {Количество секторов на дорожка}

TotSecs LongInt; {Полная длина в секторах}

Heads Byte; {Количество головок}

Tracks Word; {Число цилиндров на носителе)

ClusSize Byte; (Количество секторов в кластере}

MaxClus Word; {Максимальный номер кластера}

FATLock Word; {Номер 1-го сектора FAT}

FATCnt Byte; {Количество FAT}

FATSize Word; {Длина FAT в секторах}

FAT16: Boolean; {Признак 16-битового элемента FAT}

RootLock Word; {Начало корневого каталога)

RootSize Word; {Количество элементов каталога}

DataLock Word; {Начальный сектор данных) end;

{Список описателей диска} PListDisk = "TListDisk;

TListDisk - record

Disklnfo: TDisk;

NextDisk: PListDisk end;

var

Disk_Error : Boolean; (Флаг ошибки} Disk Status: Word; {Код ошибки} conat

Disks: PListDisk = ШЬ; {Начало списка описателей диска)

function ChangeDiskettefDisk: Byte): Boolean;

{Возвращает TRUE, если изменялось положение запора на указанном приводе гибкого диска)

Procedure FreeListDisk(var List: PListDisk);

{Удаляет список описателей дисков}

Procedure GetAbsSector(Disk,Head: Byte; CSec: Word; var Buf);

{Читает абсолютный дисковый сектор с помощью прерывания $13}

Function GetCluster(Disk: Byte;Sector: Word): Word;

{Возвращает номер кластера по заданному номеру сектора}

Function GetDefaultDrv: Byte;

/Возвращает номер диска по умолчанию)

Procedure GetDirItem(FileName: String; var Item: Dir_Type) ;

^Возвращает элемент справочника для указанного файла)

Procedure GetDirSector(Path: String; var Disk: Byte; var Dirs,DirSize: Word),

{Возвращает адрес сектора, в котором содержится начало нужного каталога, или 0, если каталог не найден. Вход:

PATH - полное имя каталога С', если каталог текущий). Выход:

DISK - номер диска;


h0317.htm

DIPS - номер первого сектора каталога или 0;

DIRSIZE - размер каталога (в элементах DIR ТУРЕ).}

Procedure GetDiskInfo(Disk: Byte; var Diskl-nfo: TDisk);

{Возвращает информацию о диске DISK}

Function GetDiskNumber(с: Char): Byte;

{Преобразует юля диска A...Z s номер О...26'. Если указано недействительное имя,возвращает 255}

Function GetFATItem(Dislc: Byte; Item: Word); Word;

{Возвращает содержимое указанного элемента FAT}

Procedure GetIOCTLInfo(Disk: Byte; var l6: юеть_Туре);

{Получить информацию об устройстве согласно общему вызову IOCTL)

Procedure GetListDisk(var List: PLtstDisk);

(Формирует список описателей дисков}

Procedure GetMasterBoot(var But);

/'Возвращает в переменной Buf главный загрузочный сектор}

Function GetMaxDrv: Byte;

{Возвращает количество логических дисков}

Function GetSectorfDisk: Byte;Cluster: Word): Word;

(Преобразует номер кластера в номер сектора}

Function PackCylSec(Cyl,Sec: Word): Word;

(Упаковывает цилиндр и сектор в одно слово для прерывания ?13}

Procedure ReadSector(Disk: Byte; Sec: Longint; NSec: Word; var Buf);

{Читает сектор (секторы) на указанном диске}

Procedure SetAbsSector(Disk,Head: Byte; CSec: Word; var Buf);

{Записывает абсолютный дисковый сектор с помощью прерывания $13}

Procedure SetDefaultDrv(Disk: Byte);

{Устанавливает диск по умолчанию}

Procedure SetFATItemtDiSk: Byte;Cluster,Item: Word);

{Устанавливает содержимое ITEM в элемент CLUSTER таблицы FAT}

Procedure SetMasterBoot(var Buf);

{Записывает в главный загрузочный сектор сеДержимое Buf}

Procedure UnPackCylSec(CSec: Word; var Cyl,Sec: Word);

(Декодирует цилиндр и сектор для прерывания $13}

Procedure WnteSector(Disk: Byte; Sec: Longint; NSec: Word; var Buf);

{Записывает сектор (секторы) на указанный диск}

IMPLEMENTATION

Oses DOS;

var

Reg: registers;

Procedure Output;

(Формирует значения Dislc_Status и Disk_Ercoc)


h0318.htm

begin

with Reg do begin

Disk_Error := Flags and FCarry =1;

Disk_Status:= ax end

end; {Output} /——————————————;

Function ChangeDiskette(Disk: Byte): Boolean;

{Возвращает TRUE, если изменялось положение запора на указанном приводе гибкого диска) begin

with Reg do begin

АН := $16;

DL := Disit;

Intr($13, Reg) ;

Output;

ChangeDiskette := Disk_Error and (AH=6) end end; {ChangeDiskett} ^————————————————/

Procedure FreeListDisklvar List: PListDisk);

{Удаляет список дисковых описателей} var

Р: PListDisk;

begin

while List <> Nib do begin

P :a List^.NextDisk;

Dispose(List) ;

List := P end end; {FreeListDisk} ^——.————————————;

Procedure GetAbsSector(Disk,Head: Byte; CSec: Word; var Buf);

{Читает абсолютный дисковый сектор с поыоп^ыо прерывания $13} begin

with Reg do begin

ah :»= 2; {Операция чтения) dl := Disk; {Номер привода} dh := Head; {Номер головки} ex := CSec; {Цилиндр/сектор} a.1 :« 1; (Читать один сектор} es := seg(Buf);

bx := of s (Buf) ;

Intr($13,Reg) ;

Output end end; /GetAbsSector^ ^——————————————;

Function GetCluster(Disk: Byte; Sector: Word): Word;

{Возвращает номер кластера по заданному номеру сектора} var

DI: TDisk;

begin

GetDiskInfo(Disk,DI) ;

if not Disic Error then with DI do


h0319.htm

Тексты программ 3)9

if (Sector-DataLock >= 0) and (TotSecs-Sector >= 0) then GetCluster := {Нормальное обращение/

(Sector-DataLock) div ClusSize+2 else

GetCluster := 0 (Неверный номер сектора} else

GetCluster := 0 {Неверный номер диска} end; {GetCluster} ^——————————————/

Function GetDefaultDrv: Byte;

{Возвращает номер диска по умолчанию} begin

with Reg do begin

АН :- $19;

MSDOS(Reg) ;

GetDefaultDrv := AL end end; {GetDefaultDrv) ^——————————„————;

Procedure GetDirItem(FileName: String; var Item: Dir_Type);

{Возвращает элемент справочника для указанного файла} var

Dir: array [1..16] of Dir_Type; {Буфер на 1 сектор каталога}

Path : DirStr; {Маршрут поиска}

NameF: NameStr; {Имя файла}

Ext : ExtStr; {Расширение файла}

Disk : Byte; {Номер диска}

Dies : Word; /Номер сектора}

DirSize: Word; {Размер каталога}

Find: Boolean; {Флаг поиска}

j : Integer; {Номер элемента каталога} {————} Procedure Findltem;

(Ищет нужный элемент в секторах каталога} var

k,i: Integer;

т: array [1..11] of Char; {Массив имени}

Clus: Word; (Номер кластера}

DI: TDisk;

begin

GetDiskInfo(Disk,DI); {Получаем длину кластера}

ReadSector(Disk,Dirs,!,Dir); {Читаем первый сектор}

k := 0; {Количество просмотренных элементов}

j := 1; {Текущий элемент каталога} {Готовим имя и расширение для поиска}

FillChar(m,ll, ' ');

Move(NameF[1],т[1],Length(NameF)) ;

if exto'' then

Move(Ext[2],т[9],Length(ext)-l);

Find := False;

{Цикл поиска}

repeat

if Dir[j] .Nametl^tO than

exit; {Обнаружен конец списка} if (Dir[j].FAttr and $18) = 0 then

begin {Проверяем очередное имя а каталоге} Find := True;

i := 1;

While Find and (i<=ll) do


h0320.htm

begin

Find := m[i]=Dir[j].NameExtti];

inc(i) end;

end;

if not Find then inc(j);

if j = 17 then begin

inc (k, 16) ;

if k >= DirSize then

exit; {Дошли до конца каталога} j := 1; {Продолжаем с 1-го элемента

следующего сектора}

if (k div 16) mod DI.ClusSize°0 then if succ(Dirs)<DI.DataLock then

inc(Dirs) (Корневой каталог} else

begin {Конец кластера} {Новый кластер} Clus :=- GetFATItem(Disk,GetCluster(Disk,Dirs));

{Новый сектор} Dirs := GetSector(Disk,Clus) end

else {Очередной сектор - в кластере/ inc(Dirs);

ReadSector(Dislt,Dirs, 1, Dir) end until Find end; {Find.Item} {————} begin (GetDicItem} (Готовим имя файла) FileName := FExpand(FileName);

FSplit(FileName, Path, NameF, Ext);

{Искать каталог} GetDirSector(Path,Disk,Dirs,DirSize);

Find := DirsoO; {Dirs'=0 - ошибка в маршруте} if Find then

Findltem; {Ищем нужный элемент} if Find then begin

(Переносим элемент каталога в Item} Move(Dir[j],Item,SizeOf(Dir_Type)) ;

{Сбросить ошибку} Disk Error := False end else

begin {Файл не найден} Disk_Error := True;

Disk_Status := $FFFF end end; tGetDirItem} ^———————————————;

Procedure GetDirSector(Path: String; var Disk: Byte; var Dirs,DirSize: Word);

(Возвращает адрес сектора, в котором содержится начало нужного каталога, или 0, если каталог не найден. Вход:

PATH - полное имя каталога ('', если каталог - текущий). Выход:


h0321.htm

DISK - номер диска;

DIRS - номер первого сектора каталога или О/ DIRSIZE - размер каталога (в элементах DIR_TYPE).} var

i,j,k Integer; {Вспомогательные переменные 1 Find Boolean; {Признак поиска) m array [1..11] of Char; {Массив имени каталога} s String; {Вспомогательная переменная} DI TDisk; {Информация о диске} Dir array [1..16] of Dir_Type; {Сектор каталога} Clus Word; {Текущий кластер каталога} label err;

begin

{Начальный этап: готовим путь к каталогу и диск} if Path = '' then {Если каталог текущий,}

GetDir(0,Path); {дополняем маршрутом поиска} if Path[2] о ':' then {Если нет диска,}

Disk := GetDefaultDrv {берем текущий} else

begin {Иначе проверяем имя диска} Disk :» GetDiskNumber(Path[l]);

if Disk-255 then

begin {Недействительное имя диска} Err: {Точка выхода при неудачном поиске}

Dirs := 0; {Нет сектора} Disk_Error :" True; {Флаг ошибки} Disk_Status :- $FFFF; {Статус fFFFF} exit end;

Delete(Path,1,2) {Удаляет имя диска из пути} end;

{Готовим цикл поиска]

if Path[l]='\' then {Удаляем символы \}

Delete(Path,I,1); /в начале} if Path[Length(Path)] = '\' then

Delete(Path,Length(Path),1); {и конце маршрута} GetDiskInfo(Disk,DI) ;

with DI do begin

Dirs := RootLock; {Сектор с каталогом} DirSize :" RootSize {Длина каталога} end;

ReadSector(Disk,Dirs,1,Dir); {Читаем корневой каталог} Clus := GetCluster(Disk,Dirs); {Кластер начала каталога} {Цикл поиска по каталогам}

Find :- Path"''; {Path-'' - конец маршрута} while not Find do begin

{Получаем в S первое имя до символа \} s := Path;

if pos('\',Path) <> 0 then

s[0] :-chr(post'\',Path)-1);

{Удаляем выделенное имя из маршрута) Delete(Path,I,Length(s)) ;

if Path[l]»'\' then

Delete (Path,1,1); '.Удаляем разделитель \} {Говим массив имени} FillChar(m,ll, ' '):


h0322.htm

322 Приложение

move(s[1],m,ord(s[0]));

(Просмотр очередного каталога}

k := 0; {Количество просмотренных элементов каталога) j :° 1; (Текущий элемент в Die} repeat (Цикл поиска в каталоге} if Dir[j],Name[l]=#0 then {Если имя}

Goto Err; {начинается с 0 - это конец каталога} if Dir(j].FAttr=Directory then begin

Find := True;

i :» 1;

while Find and (i<=ll) do

begin {Проверяем иыя] Find := m[i]=Dir[j] .NameExt[i];

inc(i) end end;

if not Find •then inc(j);

if j = 17 then

begin {Исчерпан сектор каталога} j :« 1; {Продолжаем с J--I'O элемента

следующего сектора} inc(k,16); (k - сколько элементов просмотрели} if k >= DirSize then

goto err; (Дошли до конца каталога} if (k div 16) mod DI.ClusSize=0 then

begin {Исчерпан кластер - ищем следующий} {Получаем новый кластер} Clus := GetFATItem(Disk,Clus);

{Можно не проверять на конец цепочки, т.к. каталог еще не исчерпан} {Получаем новый сектор/ Dirs := GetSector(Disk,Clus) end else (Очередной сектор -}

inc(Dirs); {в текущем кластере} ReadSector(Disk,Dirs,l,Dir);

end until Find;

{Наден каталог для очередного имени в маршруте}

Clus := Dir[j].FirstC; {Кластер начала} Dirs := GetSector(Disk,Clus); {Сектор} ReadSector(Disk,Dirs,l,Dir);

Find := Path = '' {Продолжаем поиск,

если не исчерпан путь} end {while not Find} end; {GetDlrSector} ^————————————————/

Procedure ReadWriteSector(Disk: Byte;

Sec: LongInt; NSec: Word; var Buf; Op: Byte); forward;

Procedure GetDiskInfo(Disk: Byte; var Disklnfo: TDisk);

{Возвращает информацию о диске DISK} var

Boot: TBoot;

I!. : IOCTL_Type;

p: PListDisk;

label

Get;


h0323.htm

begin

Disk_Error := False;

if (Disk<2) or (Disks=NIL) then

goto Get; {He искать в списке, если дискета или нет списка} {Ищем в списке описателей} р := Disks;

while (р".Disklnfo.NumberODisk) and (p^.NextDiskoNIb) do

p := p^.NextDisk; (Если не тот номер диска} if p'\.DiskInfo.Number=Disk then

begin (Найден нужный элемент - выход} Disklnfo := p^DiskInfo;

exit end;

(Формируем описатель диска с помощью вызова IOCTL} Get:

IO.Build.BPB := True; (Требуем построить ВРВ} GetIOCTLInfo(Disk,10); (Получаем информацию} If Disk_Error then exit;

with Disklnfo, 10 do {Формируем описатель, begin

Number a= Disk;

TypeD == TypeDrv;

AttrD - Attrib;

Cyls = Cylindrs;

Media - BPB.Media;

SectSize - BPB.SectSiz;

TrackSiz = Add.TrkSecs;

TotSecs ч BPB.TotSecs;

if TotSecs=0 then

begin (Диск большой емкости}

ReadWriteSector(Number,0,1,Boot,2); (Читаем загрузочный сектор} TotSecs :•" Boot.Add.LargSectors;

end;

Heads = Add.HeadCnt;

Tracks = (TotSecs+pred(TrackSiz)) div (TrackSiz*Heads);

ClusSize = BPB.ClustSiz;

FATLock - BPB.ResSecs;

FATCnt = BPB.PatCnt;

FATSize - BPB.FatSize;

RootLock = FATLock+FATCnt*FATSize;

RootSize » BPB.RootSiz;

DataLock = RootLock+(RootSize*SizeO?(Dir_Type)) div SectSize;

MaxClus = (TotSecs-DataLock) div ClusSize+2,-fAT16 - (MaxCius > 4086) and (TotSecs > 20790) end end; (GetDiskInfof /———————.———————/

Function GetDiskNumber(c: Char): Byte;

(Преобразует имя диска A...Z в номер О...26. Если указано недействительное имя, возвращает 255} var

DrvNumber: Byte;

begin

ifOpCase(c) in ['A'..'2'] then

DrvNumber :« ord(UpCase(c))-ord('A')

else

DrvNumber := ^55;

if DrvNumber > GetHaxDrv then


h0324.htm

DrvNumber := 255;

GetDiskNumber := DrvNumber;

end; {GetDiskNumber} /——_-——_————-.———;

Function GetFATItem(Disk: Byte;Item: Word): Word;

fBosBpastae'r содержимое указанного элемента FAT} var

DI : TDisk;

k,j,n: Integers-Fat : record case Byte of 0: (w: array [0..255] of Word);

1: (b: array [0..512*3-1] of Byte);

end;

begin

GetDiskInfo(Disk,DI) ;

if not Dislc_Error then with DI do begin

if (Item > MaxClus) or (Item < 2) then

Item := $FFFF {Задан ошибочный номер кластера) else begin

if FAT 16 then begin

k := Item div 256; {Нужный сектор FAT} j := Item mod 256; {Смещение в секторе} n := 1 {Количество читаемых секторов) end else begin

k :° Item div 1024; {Нужная тройка секторов FAT} j :~ (3*Item) аЪх 1-)t*1536; {Смещение в секторе} п := 3 {Количеетво читаемых секторов/ end;

{Чихаем 1 или 3 сектора FAT} ReadSector (Disk, FATLock+lc*n, n, Fat) ;

it not Disk_Error then begin

if FAT 16 then

Item :» Fat.wtj] else begin

n := Item; {Старое значение Item для проверки четности} Item := Fat.b[j]+Fat.b[j+l] shi 8;

if odd(n) than

Item :~ Item shr 4 else

Item :" Item and $FFF;

if Item > $FF6 then

Item :-- $FOOO+Item end;

GetFatItem := Item end end end end; {GetFATItemf /———————————————;

procedure GetIOCTLInfo(Disk: Byte; var 10: IOCTL__Type);

{Получает информацию об устройстве согласно общему вызову IOCTL}


h0325.htm

begin

with Reg do begin

ah :•" $44; {Функция 44}

al := $OD; (Общий вызов lOCTLf

cl := $60; {Дать параметры устройства}

ch := $8; (Устройство - диск)

Ы :- Di.sk+1; {Диск 1=А,..)

bh := 0;

ds := seg(IO) ;

dx := of s(IO) ;

MSDOS(Reg);

Output end

end; {GetIOCTLInfo)

{—.— —_———_-_————/

Procedure GetListDisk(var List: PListDisk);

{Формирует список дисковых описателей} var

Disk: Byte;

DI : TDisk;

P,PP: PListDisk;

begin

Disk := 2; {Начать с диска С:} List :° MIL;

repeat

GetDiskInfo(Disk,DI);

if not Disk_Error then begin New(P) ;

if List=MII. then

List := P else

PP^.NextDisk := P;

with P" do begin

DiskInfo := DI;

NextDisk := HXL;

inc(Disk) ;

PP := P end end until Disk_Error;

Disk_Error := False end; {GetListDiskf ^—————————————;

Procedure GetMasterBoot(var But) ;

(Возвращает в переменной Buf главный загрузочный сектор} begin

GetAbsSector($80,0,l,Buf) end; {GetMasterBoot} {— ———————— ————

Function GetMaxDrv: Byte;

{Возвращает количество логических дисков) consfc

Мах: Byte =0;

->egin

if Max=0 then with Reg do begin

ah := $19;


h0326.htm

MSDOS(Reg) ;

ah :=• $OE;

dl := al;

MSDOS(Reg) ;

Max := al end;

GetMaxDrv := Max end; {GetMaxDrv} /———————————.——-J;

function GetSector(Disk: Byte; Cluster: Word): Word;

{Преобразует номер кластера в номер сектора} var

DI: TDisk;

begin

GetDiskInfo(Disk,DI) ;

if not Disk Error then with DI do begin

Disk_Error := (Cluster > MaxClus) or (Cluster < 2);

if not Disk_Error then

GetSector := (Cluster-2)*ClusSize +DataLock end;

if Disk_Error then

GetSector := $FFFF end; {GetSector} ^————————————————;

Function PackCylSec(Cyl,Sec: Word): Word;

{Упаковывает цилиндр и сектор в одно слово для прерывания $13}

begin

PackCylSec := Sec+(Cyl and $300) shr 2+(Cyl shi 8) end; {CodeCylSec} ^————————————————;

Procedure ReadWriteSector(Disk: Byte;

Sec: Longint; NSec: Word; var Buf; Op: Byte);

(Читает или записывает сектор (секторы):

Op = 0 - читать; 1 - записать (малый диск)

= 2 - читать; 3 - записать (большой диск)} type

TBufO "2 record

StartSec: Longint;

Sees: Word;

AdrBuf: Pointer end;

var

BufO: TBufO-S: Word;

0: Word;

begin

if Op>l taen with BufO do begin

{Готовим ссылочную стр'^туру для большого диска} AdrBuf := Ptr(Seg(Buf) ,0?s (Buf) ) ;

StartSec := Sec;

Sees := NSec;

S := Seg(BufO) ;

0 := Ofs(BufO) ;

asm

mov CX,$FFFF nio"v й.Ь f ^ly


h0327.htm

shr ИХ,1 mov AL, Disit push DS push BP mov BX,0 mov DS,S jc @1 int 25H jmp @2 @1: int 26H @2: pop DX pop BP pop DS mov BX,1 jc @3 mov BX,0 xor AX,AX @3: mov Disk Error,BL

mov Disk Status,AX end end

else (Обращение к диску малой емкости} aSm

mov DX, Word Ptr Sec {DX := Sec/ mov CX,NSec {CX := NSec} push DS {Сохраняем DS - он будет испорчен} push BP {Сохраняем BPi ids BX,Buf {DS:BX - адрес буфера} mov AL,Op {AL := Op} shr AX,1 {Переносим младший бит Op в CF{ mov AL,Disk {AL :« Disk) jc @Write {Перейти, если младший бит ОроО} int 25H {Читаем данные} jmp @Go {Обойти запись} eWRITE:

int 26H (Записываем данные} SGO:

pop DX {Извлекаем флаги из стека) pop BP {Восстанавливаем BP} pop DS {Восстанавливаем DS} mov BX,1 {BX := True} jc @Exit {Перейти, если была ошибка} mov BX,0 {BX :~ False} xor AX, AX {Обнуляем код ошибки} QEXIT:

mov Disk_Error,BL {Флаг ошибки взять из BX} mov Disk Status,AX {Код ошибки вять из АХ} end

end; {ReadKriteSector} ^——-.—„——.——————/

Procedure ReadSectoriDisk: Byte; Sec: Longint; NSec: Word; var Buf);

{Читает сектор (секторы) на указанном диске) v^x

Dl: TDisk;

begin

GetDiskInfo(Disk,DI) ;

if Dl.TotSecs > $FFFF then {Диск большой емкости?} ReadWriteSector(Dislt,Sec,Nsec,Buf,2) {-Да: операция 2}

else

ReadWriteSector(Disk,Sec,Nsec,Buf,0) {-Нет: операция 0}


h0328.htm

end; {ReadSector} /-———————————————/

Procedure SetAbsSector(Disk,Head: Byte; CSec: Word; var Buf);

{Записывает абсолютный дисковый сектор с помощью прерывания $13} begin

with Reg do begin

ah := 3; (Операция записи} dl :° Disk; (Номер привода} dh := Head; (Номер головки} ex := CSec; {Цилиндр/сектор} al := 1; (Читаем один сектор} es := seg(Buf) ;

bx :- ofs(Buf) ;

Intr($13,Reg);

Output end end; /SetAbsSector/ ^———————————————;

Procedure SetDefaultDrvfDisk: Byte);

(Устанавливает диск по умолчанию} begin

if Disk <= GetMaxDrv then with Reg do begin

AH :=» $E;

DL := Disk;

MSDOS(Reg)

end end;

_———————————————;

Procedure SetFATItemfDisk: Byte;Cluster,Item: Word) ;

(Устанавливает содержимое ITEM в элемент CLUSTER таблицы FAT} var

DI : TDisk;

k,j,n: Integer;

Fat: record case Byte of 0: (w: array [0..255] of Word);

1: (b: array (0..512*3-1] of Byte) ;

end;

begin

GetDiskInfo(Disk,DI) ;

if not Disk_Error then with DI do begin

if (Cluster <= MaxClus) and (Cluster >=• 2) then begin

if FAT16 then

begin

k := Cluster div 256; (Нужный сектор FAT}

j := Cluster mod 256; (Смещение в секторе}

n :» 1 end else begin

k := Cluster div 1024; {Нужная тройка секторов FAT}

j := (3*Clu3ter) shr 1-k*1536;

n :° 3 end;


h0329.htm

Тексты программ 329

ReadSector (Disk, FATLoc]<+k*n,n,Fat) ;

if not Disk_Error then begin

if FAT 16 then

Fat.w[j] := Item else begin

if odd(Cluster) then

Item :- Item ehl 4 +Fat.b[j] and $F else

Item := Item+(Fat.b[j+l] and$FO) shi 12;

Fat.b[j] := Lo(Item) ;

Fat.b[j+l] :° Hi(Item) end;

if not FAT16 then

begin {Проверяем "хвост" FAT} k := k*n; {k - смещение сектора} while k+n > FatSize do dec(n) end;

inc(FATLock,k); (FATLock - номер сектора в FAT} {Записываем изменение в FatCnt копий FAT) for k := 0 to pred(FatCnt) do

WriteSectortDisk,FATLock+k*FatSize,n,Fat) end end end end; {SetFATItem} ^——————————————;

Procedure SetMasterBoot(var Buf);

{Записывает в главный загрузочный сектор содержимое Buff begin

with Reg do begin

ah := 3; {Операция записи}

al := 1; (Кол-во секторов}

dl :- $80; {1-й жесткий диск)

dh := 0; {Головка 01

сх := 1; (1-й сектор 0-й дорожки}

es := seg(Buf) ;

bx := ofs (Buf) ;

Intr($13, Reg);

Disk_Error := (Flags and FCarry о 0);

if Disk_Error then

Disk_Status :~ ah else

Disk_Status := 0 end end; {SetMasterBoot} ^-__—————————————;

Procedure UnpackCylSec(CSec: Word; var Cyl,Sec: Word);

{Декодирует цилиндр и сектор для прерывания $13} begin

Cyl := (CSec and 192) shi 2+CSec she 8;

Sec := CSec and 63 end; {RecodeCylSec} /-——————————————;

Procedure WriteSector(Disk: Byte; Sec: Longint; NSec: Word; var Buf);

{Записывает сектор {секторы) на указанный диск) var


h0330.htm

DI: TDisk;

begin

CctDiskInfo(Disk,DI) ;

if Dl.TotSecs > $FFFF then

ReadWriteSector(Disk,Sec,Nsec,Buf,3) else

ReadWriteSector(Disk,Sec,Nsec,Buf,1) ;

end; {ReadSectorf ! ===========; end. {Unit F_Disk} /»===»===.»=»;

П5. МОДУЛЬ FJMOUSE ДЛЯ РАБОТЫ С МЫШЬЮ

Описание модуля см. п.4.2.

/_=============; UNIT F_Mouse; {=="=========.==}

^——————————————————————————————+

] В этом модуле собраны процедуры и функции, ¦

¦ обеспечивающие работу устройства ввода ¦

¦ типа мышь I

+————————————————.—————————————+;

INTERFACE

{Следующий тип используется для определения элементов, выбираемых мышью (cis.SetMouseOptlon)} type

MouseItemType = record

X1,Y1,X2,Y2: Integer; {Координаты области) Butt: Word; {Условия вызова} Key : Word {Скан-код клавиши! end;

{Тип MouseHandlerType определяет процедуру обработки событий от мыши} type

MouseHandlerType = Procedure (Mask,Buttons,X,Y,DX,DY: Integer);

{Константы выбора кнопок мыши} const

LeftButton =1; (Левая кнопка)

RightButton =2; {Правая кнопка}

CenterButton =4; {Средняя кнопка}

AnyButton =7; {Любая кнопка} (Коэффициенты пересчета виртуальных координат в текстовые) const

TextRatioX: Byte = 8;

TextRatioY: Byte =8;

^————————————————————————————+

¦ Инициация мыши ¦ +—————————————————————————————+;

Function IsMouse: Boolean;

{Возвращает TRUE, если мышь доступна}

Function InitMouse: Boolean;

(Инициация мыши}

Procedure SetMousePage(Page: Byte);

{Устанавливает страницу для указателя мыши}

Function GetMousePage: Byte;

{Возвращает номер страницы с указателем}

Procedure SetStepToPixel(Hor,Ver: Integer);


h0331.htm

Тексты программ 331

{Устанавливает чувствительность мыши}

Procedure GetStepToPixel(var Hor,Ver: Integer);

{Возвращает чувствительность мыши}

Procedure SetDoubleSpeed(Speed: Word);

{Устанавливает порог удвоения скорости перемещения указателя)

Function GetDoubleSpeed: Word;

(Возвращает порог удвоения скорости} {+-—————————————————————————+

1 Координаты I +——————————————————————_——————_+;

Function MouseTextCooX(X: Integer): Byte;

{Возвращает текстовую координату по заданной виртуальной}

Function MouseTextCooYfY: Integer): Byte;

{Возвращает текстовую координату по заданной виртуальной}

Function MouseGraphCooXfX: Byte): Integer;

{Возвращает виртуальную координату по заданной текстовой)

Function MouseGraphCooY(Y: Byte): Integer;

(Возвращает виртуальную координату по заданной текстовой}

Procedure MouseWhereXY(var X,Y: Integer);

{Возвращает виртуальные координаты мыши}

Procedure MouseGotoXY(X,Y: Integer);

(Переводит указатель мыши а новое положение: X,Y - виртуальные координаты}

Function MouseWhereX: Byte;

{Возвращает горизонтальную текстовую координату}

Function MouseWhereY: Byte;

{Возвращает вертикальную текстовую координату}

Function MouseIn(XI,Y1,X2,Y2: Integer): Boolean;

{Возвращает TRUE, если указатель находится в заданном прямоугольнике} /+—————————————————————————————+

I Состояние кнопок ¦ +—————————————————————————————-+/

Function NumButton: Byte;

(Возвращает количество кнопок мыши}

Procedure GetMouseState(var Butt,X,Y: Integer);

^Возвращает текущее состояние мыши:

BUTT - флаг состояния кнопок;

X,У - текущие виртуальные координаты}

Function MousePressed: Boolean;

/Возвращает TRUE, если нажата любая кнопка}

Procedure MouseButtPressedtButt: Integer; var Stat,Count,X,Y: Integer);

{Возвращает информацию о нажатой клавише:

BUTT - флаг выбора клавиши;

STAT - состояние клавиш;

COUNT - количество нажатий, X,Y - координаты}


h0332.htm

332 Приложение

Procedure MouseButtReleased(Butt: Integer; var Stat,Count,X,Y: Integer); . {Возвращает информацию об отпущенной клавише:

BUTT - флаг выбора клавиши;

STAT - состояние клавиш;

COUNT - количество отпусканий;

X,У - координаты} ^+——————————————————————————————+

I Окна 1

+—————————————————————————————+;

Procedure MouseWindow(Xl,Yl,X2,Y2; Integer);

{Задает координаты области перемещения указателя.

XI...Y2 - виртуальные координаты}

Procedure MouseScreen;

{Устанавливает окно во весь экран} {+— —__-———————————————— ————————— +

¦ Форма указателя I +—————————————————————————————— +}

Procedure ShowMouse;

{Показать указатель мыши}

Procedure HideMouse;

{Убрать указатель мыши}

Procedure MouseTextCursor(ScrMaslc,CurMask: Word);

{Устанавливает новый вид текстового указателя}

Procedure MouseBlink(YUp,YDn: Byte);

{Задает аппаратный курсор нужного размера}

Procedure MouseGraphCursor(var ScrCurMask;X,Y: Byte);

{Задает вид графического указателя)

^————„———————————————.———————+

I Сохранение/восстановление состояния 1 +——————————————————————————————+;

Function MouseBuffSize: Word;

{Возвращает длину буфера для сохранения параметров}

Procedure SaveMouse(var Buff);

{Сохраняет в буфере текущее состояние мыши)

Procedure RestoreMouse (var Buff)-;

{Восстанавливает сохраненное состояние мыши}

^+_______———————————————--———————+

I Эмуляция клавиатуры 1 +—————————————————————————————+;

Procedure SetMouseltemtNItem: Byte; var Items);

(Устанавливает элементы для выбора мышью:

NItem - количество элементов;

Items - array [1..NItem] of MouseItemType;

Старые установки сбрасываются}

Procedure AddMouseItemdtem: MouseItemType);

{Добавляет еще один элемент для выбора мышью. Старые установки сохраняются}

Procedure ClearMouseItems;

{Сбрасывает ранее установленные элементы}

Procedure GetMouseItemfvar NItem: Byte; var Items);

{Возвращает установленные элементы} •


h0333.htm

Function KeyOrMousePressed: Boolean;

(Возвращает TRUE, если нажата клавиша или активна мышь)

Function ReadKeyOrMouse: Char;

(Возвращает символ нажатой клавиши или выбранной опции!

^+————————————————————————-.——-.——+

I Обработка событий от мыши ¦ +—————————————————————————_— —+)

Procedure SetMouseHandler(Mask: Word; Proc: MouseHandlerType);

{Устанавливает адрес и условия вызова обработчика}

Procedure ChangeMouseHandler(Mask: Word; Proc: MouseHandlerType;

var OldMask: Word; var OldProc: Pointer) (Заменяет старый обработчик новым}

Procedure ClearMouseHandler;

(Удаляет обработчик событий}

IMPLEMENTATION

^+.—.———————————————————————————+

I Инициация мыши 1

+————————————————————————————+;

Oses DOS,CRT;

type

Mouseltems - array [1..2*MaxInt dtv

SizeOf(MouseItemType)1 of MouseItemType;

PMouseIt "^Mouseltems;

const

MousePresent: Boolean » False; !Признак наличия мыши} ItemsList : PMouseIt " MXIi; {Массив элементов выбора} NMouseItem : Byte = 0; {Количество элементов выбора} MouseVisible: Boolean - Falser {Признак видимого указателя} xlm: Integer = 0; {Координаты области} ylm: Integer = 0; (перемещения указателя} x2m: Integer = 639;

y2m: Integer =• 199;

Speed2: Word - 128; {Порог удвоения скорости} VerRat: Integer » 8; {Чувствительность мыши} HorRat: Integer =8;

KButton: Byte =0; {Количество кнопок мыши}

var

Reg: registers;

Function IsMouse: Boolean;

{Возвращает TRUE, если мышь доступна} var

p : Pointer;

k,x,y: Integer;

Is : Boolean;

begin

if NButton=O then begin

GetIntVec($33,p);

Is := poiIIL;

if Is then with Reg do begin

ax := $3;

bx :» $FFFF;

Intr($33,Reg);


h0334.htm

334 Приложение

Is := bx<>$FFFF end;

MousePresent := Is end;

IsMouse := MousePresent end; {IsMouse} ^———————_———————;

Function InitMouse: Boolean;

(Инициация ыьшшл} begin

with Reg do begin

ax := 0;

Intr($33,Reg) ;

MousePresent := ax=$FFFF;

NButton :" bx end;

ClearMouseItems;

SetMousePage(0) ;

HideMouse;

MouseScreen end; {InitMouse} ^———————————————;

Procedure SetMousePage(Page: Byte);

{Устанавливает страницу для указателя мыши} begin

with Reg do begin

ax := $1D;

Ы := Page;

bh := 0;

Intr($33,Reg) end end; {SetMousePage} ^___— — ————————„-.—}

Function GetMousePage: Byte;

{Возвращает номер страницы с указателем} begin

with Reg do begin

ax :~ $1E;

Intr($33,Reg) ;

GetMousePage := Ы end end; (GetMousePage} ^———^———————————;

Procedure SetStepToPixel(Hor,Ver: Integer);

{Ус та на влив ает чувствительность мыши} begin

if IsMouse then with Reg do begin

ax := $OF;

ex := Hor and $7FFF;

dx := Ver and $7FFF;

HorRat := ex;

VerRat := dx;

Intr($33,Reg) end end; (SetStepToPixel}


h0335.htm

^—————_——___;

Procedure GetStepToPixel(var Hor,Ver: Integer);

{Возвращает чувствительность мыши} begin

if IsMouse then with Reg do begin

Hor := HorRat;

Ver := VerRat end

end; IGetStepToPixel} /—————————————_--^

Procedure SetDoubleSpeed(Speed: Word);

{Устанавливает порог удвоения скорости перемещения указателя} begin

if IsMouse then with Reg do begin

ax :° $13;

dx := Speed;

Speed.2 := Speed;

Intr($33,Reg) ;

end

end; ISetDoubleSpped.} _————————————.——;

Function GetDoubleSpeed: Word;

(Возвращает порог удвоения скорости} begin

GetDoubleSpeed := Speed2 end; {GetDoubleSpped} ^_————————————————————__———_____+

I Координаты I +__——_———_————.———_————___——___—+;

Function MouseTextCooX(X: Integer): Byte;

{Возвращает текстовую координату по заданной виртуальной} begin

MouseTextCooX := X div TextRatioX+1 end; {MouseTextCooX} /———————————————;

Function MouseTextCooY(У: Integer): Byte;

{Возвращает текстовую координату по заданной виртуальной} begin

MouseTextCooY :° У div TextRatioY+1 end; {MouseTextCooY} ^_——————————————;

Function MouseGraphCooX(X: Byte): Integer;

{Возвращает виртуальную координату по заданной текстовой} begin

MouseGraphCooX :° (X-1)*TextRatioX end; {MouseGraphCooX} ^___— _—————————_—_

Function MouseGraphCooY(Y: Byte): Integer;

{Возвращает виртуальную координату по заданной текстовой} begin

MouseGraphCooY := (У-1)*TextRatioY end; {MouseGraphCooY} ^———————————————_

Procedure MouseWhereXY(var X,Y: Integer);

/'Возвращает виртуальные координаты мыши) begin

if IsMouse then with Reg do


h0336.htm

begin

ax := $3;

Intr($33,Reg);

X := ex;

Y :° dx end else begin

X := -1;

Y := -1 end end; (MouseWhereXV) ;.- —————————— ————;

Procedure MouseGotoXY(X,Y: Integer);

{Переводит указатель иыши в новое положение: X,Y - виртуальные координаты} begin

if IsMouse then with Reg do

begin

ax := $4;

ex :» X;

dx := Y;

Intr($33,Reg) end end; {MouseGotoXY} ^———————————————^

Function MouseWhereX: Byte;

{Возвращает горизонтальную текстовую координату} begin

if IsMouse then with Reg do begin

ax := $3;

Intr($33,Reg) ;

MouseWhereX := MouseTextCooX(ex) end else

MouseWhereX := 0 end; {MouseWhereX) /___—————————————_

Function MouseWhereY: Byte;

{Возвращает текстовую координату по вертикали} begin

if IsMouse then with Reg do begin

ax :- $3;

Intr($33,Reg) ;

MouseWhereY :=- MouseTextCooY(dx) end else

MouseWhereY := 0 end; {MoueseWhereY} ^———————————————;

Function MouseIn(XI,Y1,X2,Y2: Integer): Boolean;

{Возвращает TRUE, если указатель находится в заданном прямоугольнике} begin

if IsMouse then with Reg do begin

ax :- $3;

Intr($33,Reg) ;

MouseIn := (cx>=Xl) and (cx<=X2) and (dx>-Yl) and (dx<=Y2)


h0337.htm

end else

Mousein := False end; (Mousein}

^———————————————————.——.——-——...+

¦ Состояние кнопок ¦

+-——————————————————.————_—_——+;

Function NumButton: Byte;

/'Возвращает количество кнопок ыыаш) begin

NumButton := NButton end; {NumButton} _•——————————————;

Procedure GetMouseState(var Butt,X,Y: Integer);

{Возвращает текущее состояние мыши:

BUTT - флаг состояния кнопок;

Х,У - текущие виртуальные координаты/ begin

if IsMouse then with Reg do begin

ax := $3;

Intr($33,Reg) ;

Butt := bx;

X :=» ex;

Y :- dx end else begin

Butt := 0;

X := 0;

Y := 0 end end; {GetMouseState} ^_——————————————/

Function MousePressed: Boolean;

{Возвращает TRUE, если нажата любая кнопка} begin

if IsMouse then with Reg do begin

ax := $3;

Intr($33,Reg) ;

MousePressed := bxOO end else

MousePressed := False end; {MousePressed.) __————.——————————/

Procedure MouseButtPressed(Butt: Integer; var Stat,Count,X,Y: Integer);

{Возвращает информацию о нажатой клавише:

BUTT - флаг выбора клавиши;

STAT - состояние клавиш;

COUNT - количество нажатий, X,Y - координаты} begin

if IsMouse then with Reg do begin

ax := $5;

bx :» Butt;

Intr($33,Reg) ;

Count := bx;

X := ex;


h0338.htm

Y :° dx;

Stat := bx end else

end; {MouseButtPressed} /———————————————;

Procedure MouseButtReleasedfButt: Integer; var Stat,Count»X,Ys Integer);

(Возвращает информацию об отпущенной клавише:

BUTT - флаг выбора клавиши;

STAT - состояние клавиш;

COUNT - количество отпусканий;

X,Y - координаты} begin

if IsMouse then with Reg do begin

ax := $6;

bx := Butt;

Intr($33,Reg) ;

Count :«=• bx;

X := ex;

Y := dx;

Stat := bx end else

end; (MouseButtReleased.) ^+—————————————————————————————+

I Окна I +———.——.-—————————————————————.^

Procedure MouseWindow(XI,Y1,X2,Y2: Integer);

{Задает координаты области перемещения указателя.

XI...Y2 - виртуальные координаты} begin

if IsMouse then begin

xlm := XI;

ylm := Yl;

x2m •.ss X2;

y2m := Y2;

with Reg do begin

ax » $7 ex = XI dx = X2 Intr($33 Reg) ;

ax - $8 ex = Yl dx = Y2 Intr($33,Reg) end end end; {MouseWinciow} ^-.—————————————;

Procedure MouseScreen;

(Устанавливает окно во весь экран} var

х2,у2: Integer;

begin

if IsMouse then with Reg do begin

ah := ?F;


h0339.htm

Intr($lO,Reg);

case al of 1,4,5,13: begin

x2 :» 319;

y2 := 199 end;

15,16: begin

x2 := 639;

y2 :» 349 end;

17,18: begin

x2 :- 639;

y2 := 479 end;

else

x2 := 639;

y2 := 199 end end;

MouseWindow(0,0,x2,y2) end; {MouseScreen} ^—————————————————————————————+

I Форма указателя I +—————.———————————————————————+;

Procedure ShowMouse;

(Показать указатель мыши/ begin

if isMouse and not MouseVisible then with Reg do begin ax :- $1;

Intr($33,Reg);

MouseVisible :» True and end; {ShowMouse} ^—..————————————.^

Procedure HideMouse;

{Убрать указатель мыши/ begin

if IsMouse and MouseVisible then with Reg do begin

ax := $2;

Intr($33,Reg);

MouseVisible :- False end end; (HideMouse) ^———————————————;

Procedure MouseTextCursor(ScrMask,CurMask: Word);

(Устанавливает новый вид текстового указателя} begin

if IsMouse then with Reg do begin

ax := $A;

bx :=• 0;

ex :» ScrMask;

dx := CurMask;

Intr($33,Reg) end

end; {MouseTextCursor} ^———————————_———_


h0340.htm

340 Приложение

Procedure MouseBlink(YUp,YDn: Byte);

(Задает аппаратный курсор нужного размера} begin

if IsMouse then with Reg do begin

ax := $A;

bx := 1;

ex := YOp;

dx :- YDn;

Intr($33.Reg) end end; {MouseBlink} ^——————————————/

Procedure MouseGraphCursor(var ScrCurMask;X,Y: Byte);

(Задает вид графического указателя} begin

if IsMouse then with Reg do begin

ax := $9;

bx :- X;

ex :- Y;

es :° seg(ScrCurMask);

dx := ofs(ScrCurMask);

Intr($33,Reg) end

end; (MouseGraphCursor} ^-----------——————---------——-——-———+

I Сохранение/восстановление состояния I +-----------—•--——-----———-——------—--—+;

Function MouseBuffSize: Word;

(Возвращает длину буфера для сохранения параметров) begin

if IsMouse then with Reg do begin

ax :- $15;

bx :•» 0;

Intr($33,Reg);

MouseBuffSize :- bx end else

MouseBuffSize :« 0 end; {MouseBuffSize} ———————————.——-..——;

Procedure SaveMouse(vac Buff);

(Сохраняет в буфере текущее состояние шдши} begin

if IsMouse then with Reg do begin

ax :° $X6;

es :« seg(Buff);

dx :- of s (Buff) ;

Intr($33,Reg> end end; (SaveMouse} {., —————————— ————;

Procedure RestoreMouse(vac Buff);

{Восстанавливает сохраненное состояние мыши} begin

if IsMouse then with Reg do begin


h0341.htm

ax = $17;

es = seg(Buff) ;

dx •= ofs(Buff) ;

Intr($33,Reg) end

end; {RestoreMouse} _•+—————————————————————————————+

I Эмуляция клавиатуры I +————————_——.——————.——-_—.————_+; _

const

DoubleChars: Boolean = False;

var

SecChar: Char;

Procedure SetMouseItem(NItem: Byte; var Items);

{Устанавливает элементы для выбора мышью:

NItetti - количество элементов;

Items - array [I..NItem] of MouseItemType;

Старые установки сбрасываются} begin

if IsMouse then begin

ClearMouseItems;

GetMem(ItemsList,NItem*SizeOf(MouseItemType));

Move (Items, ItemsList^NIten^SizeOftMouseItemType));

NMouseItertt := NItem end end; {SatMouseItem} /——_-——————_————;

Procedure AddMouseItemdtem: MouseItemType) ;

{Добавляет еще один элемент для выбора мышыэ. Старые установки сохраняются} var

р: PMouseIt;

k: Byte;

begin

if IsMouse then begin

k := NMouseItem;

GetMem(P,(k+1)*SizeOf(MouseItemType)) ;

Move(ItemsList",P",k*3ize0f(MouseItemType));

Move(Item,Pл[k+1],SizeOf(MouseItemType)) ;

ClearMouseItems;

NMouseItem := k+1;

ItemsList :° P end end; {AddMouseItem} /——————————— ———}

Procedure ClearMouseItems;

(Сбрасывает ранее установленные элементы} begin

if IsMouse and (NMouseItem <>0) then begin

FreeMem(ItemsList,NMouseItem*SizeOf(MouseItemType));

NMouseItem := 0 end

end; {ClearMouseItemf ^———————————————;

Procedure GetMouseItem(var NItem: Byte; var Items);

(Возвращает установленные элементы}


h0342.htm

begin

if IsMouse and (NMouseItemOO) then begin

NItem := NMouseItem;

Move(ItemsList",Items,NMouseItem*SizeOf(MouseItemType)) end end; {GetMouseItem} ^——————————————_/

Function KeyOrMousePressed: Boolean;

{Возвращает TRUE, если нажата клавиша клавиатуры или кнопка ыыши} vac

b,k: Integer;

MouseActive: Boolean;

begin

(Сначала проверяем клавиатуру} if KeyPressed then

KeyOrMousePressed := True

{Если не нажата никакая клавиша/ проверяем нажатие кнопок юани} else with Reg do begin

ax :- $3;

Intr($33,Reg);

if (bx<>0) and (NMouseItemOO) then

{Да, кнопка нажата. Организуем цикл проверки по всем элементам} begin

MouseActive :» False;

for k := 1 to NMouseItem do if not MouseActive then

with ItemsList^k] do begin

case Butt of

LeftButton : b :=bx and LeftButton;

RightButton : b :=bx and RightButton;

CenterButton: b :-=bx and CenterButton;

AnyButton : b :- bx else b :« 0;

end; {caaef MouseActive := (b<>0) and

MouseIn(MouseGraphCooX<Xl),MouseGraphCooY(YD,

MouseGraphCooX(X2),MouseGraphCooY(Y2)) end; /for, if}

KeyOrMousePressed := MouseActive end {if (bx<>0) and...}

{Если не активна клавиатура яди не выбран элемент, возвращаем False} else {Ьх=0 или NMouseItemOO}

KeyOrMousePressed := False end {with Reg} end; {KeyOrMousePressed} ^————.—————————;

Function ReadKeyOrMouse: Char;

(Возвращает символ нажатой клавиши или выбранного элемента} var

k: Byte;

b,bb: Word;

MouseActive: Boolean;

label

loop;

begin


h0343.htm

{Сначала проверяем нажатие клавиши} loop:

if not IsMouse or KeyPressed then

ReadKeyOrMouse :=• ReadKey

{Теперь проверим эмуляцию служебной клавиши} else if DoubleChars then begin

DoubleChars •." False;

ReadKeyOrMouse := SecChar end

{Проверяем необходимость контроля элементов экрана для эмуляции клавиатуры! else if NMouseItemoO then with Reg do begin {Да, нужна проверка} MouseActive := False;

lКонтролируем выбор мышью одного из элементов} ах := $3;

Intr($33,Reg); {Получаем статус кнопок} bb := Ьх; {Запоминаем его в ЪЪ}

if bboO then {Если нажата любая кнопка, то организуем проверку всех элементов до нужного (ActiveMouse станет True)} for k := 1 to NMouseItem do if not MouseActive then

with ItemsList^Ik] do begin case Butt of

LeftButton : b :=№ and LeftButton;

RightButton : b :"bb and RightButton;

CenterButton: b :=bb and CenterButton;

AnyButton : b := bb;

else

b := 0;

end;

if (b<>0) and Mouseinf

MouseGraphCooX(Xl),MouseGraphCooY(Yl) , MouseGraphCooX(X2),MouseGraphCooY(Y2)) then begin {Найден отмеченный элемент} MouseActive := True;

ReadKeyOrMouse := Char(Lo(Key)) ;

if Lo(Key)=0 then

begin (Эмуляция служебной клавиши} DoubleChars :=• True;

SecChar :•» chr(HitKey)) end end

end; {for ... if not MouseActive}

{Если мышь не отметила элемент, повторяем с начала} if not MouseActive then

goto loop end {if NMouseItemoO}

{Если не установлен ни один элемент для мыши, ждем нажатия любой клавг1ши} else

ReadKeyOrMouse :•' ReadKey end; {ReadKeyOrMouse) _•+—————————————————————————————+

I Обработка событий от мыши I +—_——————————————————————————— +{

coast

OldUserProc: Pointer = MIIi;

vac


h0344.htm

344 Приложение

UserProc: MouseHandlerType absolute OldCJserProc;

OldAX: Word;

Procedure MouseHandler; Par; Assembler;

{Ассемблерный интерфейс для вызова обработчика} ASM (Сохраняем в стеке регистры}

push Ьр

push ds

push es

push ax

mov ax,SEG 6 DATA

mov ds, ax

pop ax

mov OldAX,ax {Проверяем условия вызова}

mov ax,Word ptr [OldUserProc] fax - сегментадреса/

or ax,Word ptr [OldUserProc+2] (Адрес = NIL?}

jz @ {Да - не вызывать} (Готовим вызов процедуры пользователя}

mov ах,OldAX

push ax {Mask :- ах}

push Ьх /Buttons ;« Ьх)

push сх (X := сх}

push dx {У :- dx}

push di {DX :- dl}

push si 'DY :» si} {Вызываем процедуру пользователя}

call [OserProc]

{Выход из процедуры: восстанавливаем регистры} @: pop es

pop ds

pop bp

ret far

end; {MouseHandler} /-——_-——————————;

Procedure SetMouseHandler(Mask: Word; Proc: MouseHandlerType);

{Устанавливает адрес я условия вызова обработчика) begin

if IsMouse then with Reg do begin

UserProc :~ Proc;

ax :- $OC;

ex := Mask;

es := seg(MouseHandler);

dx :- ofs(MouseHandler) ;

Intr($33,Reg) end

end; {SetMouseHandlet} ^———————————————;

Procedure ChangeMouseHandler(Mask: Word; Proc: MouseHandlerType;

var OldMask: Word; var OldProc: Pointer);

/Заменяет старый обработчик новым} begin

if IsMouse then with Reg do begin

OldProc := OldUserProc;

ax := $14;

ex := Masit;

ea :» seg(MouseHandler);


h0345.htm

Тексты программ__________________________ _____________ __345

dx := ofs(MouseHandler);

Intr($33,Reg);

OldMask := ex end

end; {ChangeMouseHandler! ^————————.———————;

Procedure ClearMouseHandler;

(Удаляет обработчик событий} begin

if IsMouse then with Reg do begin

ax := $OC;

ex := 0;

es :=• 0;

dx := 0;

Intr($33,Reg) end;

end; {ClearMouseHandler} ^==»-====»»==; end. {F_Mouse} {—»—==——=-===}

П6. МОДУЛЬ F EMS ДЛЯ РАБОТЫ С ОТОБРАЖАЕМОЙ ПАМЯТЬЮ

Описание модуля см. п.5.3.

(»=========»===-; Unit F_EMS; f-—==—=-»-«-===/

^—————————————————————————————+

I Этот модуль содержит объекты и подпрограммы f I для работы с EMS-паыятью 1 +——————.———_——————————————————+/

{$X+,N1-,E+)

INTERFACE

^———————————————————————————————;

type

/——----— Базовый объект иерархии -—-————} PEMSArea =ATEMSArea,• TEMSArea " Object

Handle: Word; {Дескриптор}

MaxPag: Word; (Количество страниц}

Size: LongInt; (Длина используемой памяти}

Constructor Init(ASize: LongInt);

Constructor Load(var F: File);

Destructor Done; Virtual;

Peocedure EMSError(NError: Byte); Virtual;

Procedure Store(var F: File); Virtual;

Procedure WriteEMS(var Source; Dest,Sz: LongInt); Virtual;

Procedure ReadEMS(Source: LongInt; var Dest; Sz: LongInt); Virtual;

/———————; private (——————)

Function ReadFilefvar F: File; var Dest; Sz: Word): Boolean; Virtual;

Function WriteFile(var F: file; var Source; Sz: Word): Boolean; Virtual;

end;

{—————— Одномерный массив a EMS ——————}

PEMSVector -"TEMSVector;

TEMSVector - object (TEMSArea)

ItemS : LongInt; {Длина элемента массива)

Minind; LongInt; {Минимальный индекс}

Maxind: LongInt; {Максимальный индекс}

Constructor Init(ASize,Min,Max: LongInt);

Constructor Load(var F: File);


h0346.htm

346 Приложение

Procedure Store(var F: File); Virtual;

Procedure Setltem(var Source; Index: Longint);

Procedure GetItemtvar Dest; Index: Longint);

Function SingleItem(Index: Longint): Single;

Function Doubleltem(Index: Longint): Double;

Function Realltem(Index: Longint): Real;

Function ExtendedItem(Index: Longint): Extended;

Function IntegerItemdndex: Longint) : Integer;

Function LongIntItem(Index: Longint): Longint;

Function Byte I tern(Index: Longint): Byte;

end;

{---------- Двумерный пассив в EMS ----------}

PEMSMatrix =^TEMSMatrix;

TEMSMatrix = object (TEMSVector)

Minlndl: Longint; {Минимальный индекс!

MaxIndl: Longint; (Максимальный индекс}

MinInd2: Longint; {Минимальный индекс}

Maxlnd2: Longint; {Максимальный индекс}

Constructor Init(ASize,Minl,Maxl,Min2,Max2: Longint);

Constructor Load(var F: File);

Procedure Store(var F: File); Virtual;

Function GetVedndex(Indl,Ind2: Longint): Longint;

Procedure SetItem(var Source;Indl,Ind2: Longint);

Procedure GetItemfvar Dest;Indl,Ind2: Longint);

Function SingleItemdndl, Ind2: Longint): Single;

Function DoubleItemdndl, Ind2: Longint): Double;

Function Real Item(Indl,Ind2: Longint): Real;

Function ExtendedItemtIndl,Ind2: Longint): Extended;

Function IntegerltemlIndl,Ind2: LengInt): Integer;

Function LongIntItem(Indl,Ind2: Longint): Longinc;

Function BytPltem(Indl,Ind2: Longint): Byte;

end;

{---------- Многомерный массив в ЕМЗ —-—--—}

TIndexList - array [l-.MaxInt div 2] of Longint;

TIndex = array [l-.MaxInt div 6,1..3] o? Longint;

PIndex ="TIndex;

TIndexBond = array [l..Max!nt div 4,1..2] of Longint, PEMSArray -"TEMSArray;

TEMSArray = object (TEMSVector)

Nindex: Word; {Колячество измерений)

Index : PIndex:

Constructor Init(ASize: Longint; NInd: Word,- var Ind)?

Constructor Load(var F: File);

Destructor Done; Virtual;

Procedure Store(var F: File); Virtual;

Function GetVeclndex(var Ind): Longint;

Procedure Setltemfvar Source,Ind);

Procedure GetItem(var Dest,Ind);

end;

{—-- Имитатор файла последовательного доступа ----} PEMSType ="TEMSType;

TEMSType » object (TEMSArea)

Pos: Longint; {Текущая позиция от начала памяти,"

Constructor Init(ASize: Longint;;

Constructor Load(vac F: Pile);

Procedure Store(var F: File); Virtual;

Procedure SetItem(var Source; Sz: LotigInt) ;

Procedure GetItemtvar Dest; Sz: Longint);

end;


h0347.htm

{-------- Имитатор текстового файла ---------^

PEMSText ^TEMSText;

TEMSText ° object (TEMSType)

Procedure SetItem(S: String);

Function Getltem: String;

end;

{-————— копия экрана в EMS-памяти ————-} PEMSScreen =^TEMSScreen;

TEMSScreen = object (TEMSArea)

Mode: Byte; {Код режиыа)

Constructor Init;

Constructor Load(var P: File) ;

Procedure Store(var F: File); Virtual;

Procedure PutScreen;

Procedure GetScreen;

end;

var

EMSStatus: Byte; {Статус последней операции}

Function IsEMS: Boolean;

{Возвращает TRUE, если в ПК имеется EMS-память}

function GetEMMVersion: String;

{Возвращает номер версии EMM в формате 'Х.Х'}

Function EMSSeg: Word;

{Возвращает сегментную часть адреса окна EMS-памяти}

Procedure GetEMSInfo(var AllPage, Pages: Word);

{Возвращает полное количество (AllPages) и количество незанятых (Pages) страниц}

Procedure MewEMSHandle(var Handle: Word;Pages: Word);

{Открывает новый дескриптор Handle и связывает с ним Pages страниц EMS}

Procedure DisposeEMSHandle(var Handle: Word);

{Удаляет дескриптор Handle и освобождает связанную с ниш память}

Procedure MapEMSPage(Handle,Physic,Logic: Word);

{Картирует окно, связывая его Physic физическую страницу с

Logic логической страницей дискриптора Handle! const

EMSErrorFlag : Boolean =' False;

RegHeadIEMSArea : String [14]='F_EMS TEMSArea'

RegHeadTEMSVector: String [14]='F_EMS TEMSVect'

RegHeadTEMSMatrix: String [14]='F_EMS TEMSMatr'

RegHeadTEMSArray : String [14]='F_EMS TEMSArra

RegHeadTEMSType : String [14]-•F_EMS TEMSType'

RegHeadTEMSScreen: String [14]='F_EMS TEMSScre' /——-_———————_——————————————„————;

IMPLEMENTATION ,———————————————————————————————/

Uses DOS,Graph,F Text;

var

Reg: registers;

const

EMSVer : riord =0; {Версия iSMM; используется как флаг проверки наличия EMS) EMSS : Word =0; {Сегмент окна}


h0348.htm

LPage=16*1024; {Длина страницы} I --------- Базовый объект иерархии ----------}

Constructor TEMSArea.Init(ASize: Longint);

{Создает объект TEMSArea. ASize - размер требуемой ЕМЗ-памяти в байтах} vaa:

All,Pag: Word;

begin

if not IsEMS then

EMSError($A5) {Нет EMS} else begin

EKSErrorFlag := False;

Size := ASize;

MaxPag := (Size+LPage-1) shr 14;

GetEMSInfo(All,Pag) ;

if MaxPag>Pag then

EMSError($88) (Нет требуемых страниц) else begin

NewEMSHandle(Handle,MaxPag) ;

EMSError(EMSStatus) end end

end; {TEMSArea.Init} ' (— ————————— ——;

Function TEMSArea.ReadFile(var F: File; var Dest; Sz: Word): Boolean;

{Читает Зг байт из файла F в переменную Dest и контролирует результат} var

К: Word;

begin

BlockRead(F,Desc,Sz,K) ;

if KOSz then begin

EMSError($A7) ;

ReadFile := False (Ошибка при чтении} end else

ReadFile := True {Нет ошибок} end; {ReadFilo} ^—————————————

Constructor TEMSArea.Load(var F: File);

{Создает объект TEMSArea, считывая его изфайла F. Файл должен быть открыт на чтение с длиной блоков в 1 байт и позиционирован на место, где ранее был сохранен объект TEMSArea процедурой. Store.} var

SRead,Rest: Longint;

S: Strings-All,k: Word;

Stop: Boolean;

P: Pointer;

begin

if not IsEMS then

EMSError($A5) {Нет EMSf else begin

{Читаем заголовок объекта - строку RegHeadTEMSArea EMSErrorFlag :=• Fals&;

Stop := False; {Флаг нормального чтени^ч if not ReadFile(F,S,SizeOf(RegHeadTEMSAreaU or (SORegHeadTEMSArea) then


h0349.htm

Тексты программ 349

EMSError($A6) {Ошибка чтения или несовпадение заголовка} else {Читаем поля МахРад и Size} begin

if not (ReadFile(F,MaxPag,2) and ReadFile(F,Size,4)) then

Exit; {Была ошибка при чтении полей} (Проверяем доступную память} GetEMSInfo(All,k);

if k<MaxPag then

EMSError($88) {Нет нужной памяти} else begin

{Пытаемся создать дескриптор) NewEMSHandle(Handle,MaxPag) ;

if EMSStatusoO then

EMSError(EMSStatus) else

begin {Читаем содержимое памяти} Rest :=• Size; {Непрочитанный остаток} Р := Ptr(EMSSeg,0);{Адрес начала физической страницы окна} АН := 0; (Начинаем с 0-й логической страницы} Stop := False;

while (RestoO) and not Stop do begin

MapEMSPage (Handle, 0,AU);

EMSError(EMSStatus);

if EMSStatusoO then

Exit; (Ошибка картирования} if Rest>LPage then

SRead := Lpage else

SRead :=• Rest;

Stop :- not ReadFile(F,P",SRead);

Dec(Rest,SRead) ;

Inc(All) end end end end end

end; {TEMSArea.Load} /———————————;

function TEMSArea.WriteFile(var F: Pile; var Source; Sz: Word): Boolean;

{Записывает Sz байт из переменной Source в файл F и контролирует результат) var

К: Word;

begin

BlockWrite(P,Source,Sz,К) ;

if KoSz then begin

EMSError($A8) ;

WriteFile := False {Ошибка при записи) end else

WriteFile := True (Нет ошибок} end; {TEMSArea.WriteFile) ^-————————————;

Procedure TEMSArea.Storetvar F: Pile);


h0350.htm

350 Приложение

{Записывает объект TEMSArea в файл F. Файл должен быть открыт на валясь с длиной блоков в 1 байт и позиционирован на нужное место (обычно ~ а конец файла) } var

SRead,Rest: LongInt;

S: String;

All,k: Word;

Stop: Boolean;

P: Pointer;

begin

if not IsEMS then

EMSError(?A5) {Нет EMS} else begin

{Записываем заголовок объекта - строку RegHeadTEMSArea} EMSErrorFlag := False;

S := RegHeadTEMSArea;

if WriteFile(F,S,SizeOf(RegHeadTEMSArea))

then begin {Записываем поля MaxPag и Size} if WriteFile(F,MaxPag,2) and

WriteFile(F,Size,4) then

begin /Записываем содержимое памяти} Rest := Size; {Незаписанный остаток} Р := Ptr(EMSSeg,0); {Адрес начала физической страницы окна} All := 0; {Начинаем с 0-й логической страницы) Stop :=• False; {Признак ошибки} while (RestoO) and not Stop do begin

MapEMSPage(Handle,0,All);

EMSError(EMSStatus) ;

if EMSStatusOO then

Exit; {Ошибка картирования} if Rest>LPage then

SRead := LPage else

SRead := Rest;

Stop:= not WriteFile (F.V, SRead);

Dec(Rest,SRead);

Inc(All) end end end end end; {TEMSArea.Store} {——— ——————_——;

Destructor TEMSArea.Done ;

{Уничтожает объект TEMSArea и освобождает связанную с ним память} begin

if not IsEMS then

EMSError($A5) {Нет EMS} else begin

DisposeEMSHandle(Handle) ;

EMSError(EMSStatus) end

end; {TEMSArea.Done} ;———————————;

Procedure TEMSArea.WtiteEMS(var Source; Dest,Sz: Longint);

{Записывает Sz байт из переменной Source в EMS,


h0351.htm

начиная с позиции Dest байт от ее начала) var

Rest,Pos,k: Longint;

Рад: Word;

PD,PS: Pointer;

PW: record

S,0: Word end absolute PS;

Stop: Boolean;

begin {$IFSDEF NOTCHECK}

if (Sz<0) or (Dest+Sz>Size) then

EMSError($AA) {Запись за границей памяти} else {?endIF} begin

Рад := Dest div LPage; {Логическая страница} Pos := Dest mod LPage; {Смещение в ней) PS := @Source; {Указатель в источнике} PD :- ptr(EMSS,Pos); {Указатель в EMS} Stop :» False; (Флаг ошибки картирования) Rest :== Sz; {Остаток записи} repeat {Цикл по страницам EMS} MapEMSPage(Handle,0,Рад); {Картируем окно} EMSError(EMSStatus) ;

Stop := EMSStatusOO; {Признак ошибки} if not Stop then begin

{Определяем размер Sz очередного блока:} if Rest>LPage-Pos then

Sz := LPage-Pos else

Sz := Rest;

MovefPS^PD^Sz) ; ' {Переносим блок} Dec(Rest,Sz); (Уменьшаем остаток} Inc(Рад); {Следующая логическая страница} PD := ptr(EMSS,0); (Указатель - а ее начало} Pos := 0;

Inc(PW.O,Sz); (Смещение в источнике} {Нормализуем указатель PS источника:} PW.S :» PW.S+(PW.O Shr 4);

PW.O := PW.O mod 16 end

until Stop or <Rest=0) end

end; {TEMSArea.WriteEMS} /———_————————/

Procedure TEMSArea.ReadEMS(Source: Longint; var Dest; Sz: Longint)-{Читает Sz байт из EMS-памяти, начиная с байта Source от ее начала, в переменную Dest} var

Rest,Pos,k: Longint;

Рад: Word;

PD,PS: Pointer;

PW: record S,0: Word end absolute PD;

Stop: Boolean;

begin (fIFNDEF NOTCHECK}

±f (Sz<0) or (Source+Sz>Size) then

EMSError($A9) {Чтение за границей памяти}


h0352.htm

else

{$endIF} begin

Pag :• Source div LPage; {Логическая страница} Pos := Source mod LPage; {Смещение в ней) PD := @Dest; {Указатель в приемнике} PS := ptr(EMSS,Pos); {Указатель в источнике} Stop := False; {Флаг ошибки картирования} Rest :=' Sz; ^Остаток чтения} repeat {Цикл по страницам EMS} MapEMSPage(Handle,0,Pag); {Картируем окно} EMSError(EMSStatus) ;

Stop :- EMSStatusOO; {Признак ошибки} if not Stop then begin

{Определяем размер Sz очередного блока:} if Rest>LPage-Pos then

Sz :-= LPage-Pos else

Sz := Rest;

Move(PS",PD^,Sz); {Переносим блок} Dec(Rest,Sz); {Уменьшаем остаток} Inc(Pag); {Следующая логическая стр.} PS :-= ptr(EMSS,0) ;

Pos :° 0;

Inc(PW.O,Sz); {Смещение в приемнике} {Нормализуем, указатель PD приемника:} PW.S :» PW.S+(PW.O shr 4);

PW.O ;= PW.O mod 16 end

until Stop oe (Rest-0) end

end; (TEMSArea.ReadEMS} /—.——_-_———__-_-,

Procedure TEMSArea.EMSError(NError: Byte);

{Получает управление при ошибках EMM илипри выполнении методов объекта. По умолчанию выводит сообщение с номером NError.! const

Msg: array [$80..$AD] of String »( 'Внутренняя ошибка EMM', 'Сбой EMS-платы",

'EMM занят обработкой предыдущего запроса', 'Неверный дескриптор окна',

'Запрошена неопределенная в данной версии EMM функция', "Нет доступных дескрипторов окон', 'Ошибка при сохранении или восстановлении окна', 'Запрос распределения превышает общую EMS-память', 'Запрос распределения превышает число доступных страниц', 'Попытка создать дескриптор с нулевым количеством страниц', 'Дескриптор не располагает таким числом страниц', 'попытка картировать больше 4 страниц", ,

•Переполнение области сохранения картирующего контекста .

'Попытка повторного сохранения картирующего контекста',

"Попытка восстановления несохраненного контекста",

'Не определен параметр подфункции',

1 Неизвестный тип атрибутов',

'Нет аппаратной поддержки сохраняемых страниц ,

•Источник и приемник информации одновременно находятся в ЕМЗ-памяти',

'Размер приемника информации слишком мал',

'Стандартная память частично перекрывает расширенную память",


h0353.htm

'Слишком большое смещение в перемещаемом блоке',

'Размер перемещаемого блока больше 1 Мбайт',

'Источник и приемник связаны с одним дескриптором и частично перекрываювся',

'Недопустимый тип памяти источника или приемника',

'Неопознанная ошибка',

'Нет аппаратной поддержки альтернативной установки страниц',

•Исчерпаны все допустимые установки альтернативных регистров',

'Не поддерживается установка альтернативных регистров",

'Неправильная установка альтернативных регистров',

'Назначенные каналы прямого доступа к памяти (КПДП) не поддерживаются',

'Указанный КПДП не поддерживается',

'Дескриптор не поименован',

'Указанное имя дескриптора уже существует',

•Источник выходит за границу 1 Мбайт',

'Содержимое указанное области данных разрушено',

'Нет доступа к указанной функции',

"Нет ЕМЗ-памяти или не установлен драйвер EMM.SXS',

'Неверный формат файла',

'Ошибка при чтении объекта из файла',

'Ошибка при записи объекта в файл',

"Попытка чтения за границей доступной ЕМЗ-памяти"^

'Попытка записи за границей доступной ЕМЗ-памяти"у

'Неверные границы индексов',

'Размер элемента вектора не соответствует длине переменной',

'Изменен режим работы дисплея (объект TEMSScreen)>

);

begin

if NError»0 then begin

EMSErrorFlag :» False;

Exit end;

EMSErrorFlag := True;

if NError in [?80..$AD] then

WriteLn(Msg[NError)) else

WriteLn('Ошибка номер ',NError) end; {TEMSArea.EMSError} {---—---— Одномерный массив s JEMS -———----;

Constructor TEMSVector.Init(ASize,Min,Max: LongInt);

{Создает объект TEMSVector:

ASize - размер элементов пассива в байтах;

Min,Max - границы индекса.} var

Sz: LongInt;

begin

if Min>Max then begin

EMSError($AB); {Неправильные границы} Exit end;

Sz := ASize*(Max-Min+1); {Определяем размер} TEMSArea.Init(Sz); {Создаем TEMSArea} if not EMSErrorFlag then begin

ItemS := ASize;

Minind := Min;

Maxind := Max end end; {TEMSVector,lait}


h0354.htm

^_— ————__—}

Constructor TEMSVector.Load(var F: File);

{Создает объект TEMSVector - читает из файла базовый объект TEMSArea, затем заголовок и поля ItemS, Minind, Maxind.} var

S: String;

begin

TEMSArea.Load(F); {Загружаем из файла базовый объект} if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSVector))

and (S=RegHeadTEMSVector) then begin

if ReadFile(F,Items,4) then if ReadFile(F,MinInd,4) then ReadFile(F,Maxind,4) ;

if EMSErrorFlag then

Done end else

EMSError($A6) end; {TEMSVector.Load} ^————————————;

Procedure TEMSVector.Store(var F: File);

{Сохраняет вектор в файле - сначала сохраняет базовый объект, потом заголовок и поля ItemS, Minind, Maxind.}

begin

TEMSArea.Store(F) ;

if not EMSErrorFlag then begin

if WriteFile(F,RegHeadTEMSVector, SizeOf(RegHeadTEMSVector)) then if WriteFile(F,ItemS,4) then if WriteFile(F,Minind,4) then

WriteFile(F,Maxind,4) end end; {TEMSVector.} ^__—___——.__————;

Procedure TEMSVector.Setltem(var Source; Index: LongInt);

{Помещает в EMS элемент с индексом Index из переменной Source) begin HIFNDEF NOTCHECK}

if (Index>MaxInd) or (Index<MinInd) then

EMSError($AB) {Неправильный индекс} else {$endIFf

WriteEMS(Source,(Index-MinInd)*ItemS,ItemS) end; {TEMSVector.Setltem} ^__-.__—— _——_———;

Procedure TEMSVector.GetItem(var Dest; Index: LongInt);

{Читает из EMS элемент массива с индексом Index} begin {$IFNDEF NOTCHECK} if (Index>MaxInd) or (Index<MinInd) then

EMSError($AB) (Неправильный индекс} else {$endIF}

ReadEMS((Index-MinInd)*ItemS,Dest,ItemS) end; {TEMSVector.GetItem (•—————_———— -,-}


h0355.htm

Тексты программ 355

Function TEMSVector.SingleItemfIndex: LongInt): Single;

var

X: Single;

begin {$IFNDEF NOTCHECK}

if ItemSoSizeOf (Single) then

EMSError($AC) (Ошибка в длине элемента} else {$endIF} begin

GetItem(X,Index) ;

Singleltem :- X end

end; {TEMSVector.SingleItem} {—. _______——_____-;

Function TEMSVector.DoubleItem(Index: LongInt): Double;

var

X: Double;

begin ($IFNDEF NOTCHECK}

if ItemSoSizeOf (Double) then

EMSError($AC) {Ошибка в длине элемента} else {$endIF} begin

Getltem(X,Index) ;

DoubleItem := X end

end; {TEMSVector.DoubleItem} {-,..————————— —/

Function TEMSVector.RealItemfIndex: LongInt): Real;

var

X: Real;

begin ($IFNDEF NOTCHECK} if ItemSoSizeOf (Real) then

EMSError($AC) {Ошибка в длине элемента} else ffendIF} begin

GetItem(X,Index) ;

Realltem := X end

end; {TEMSVector.Realltem} ^————————————;

Function TEMSVector.ExtendedItemtIndex: LongInt): Extended;

var

X: Extended;

begin !$IFNDEF NOTCHECK}

if ItemSoSizeOf (Extended) then

EMSError($AC) {Ошибка в длине элемента} else l$endIF} begin

Getltem(X,Index) ;

Extendedltem := X end

end; ITEMSVector.Extendedltem} ^————————————;


h0356.htm

356 Приложение

Function TEMSVector.IntegerItem(Index: Longint): Integer;

var

X: Integer;

begin ($IFNDEF KOTCHECK} if ItemSoSizeOf (Integer) then

EMSError($AC) (Ошибка в длине элемента} else ($endIFI begin

GetItem(X,Index);

IntegerItem := X end

end; {TEMSVector.IntegecItem) (———.———————/

Function TEMSVector.LongIntItemlIndex; Longint): Longint;

var

X: Longint;

begin {$IFNDEF NOTCHECK}

if ItemSOSizeOftLongInt) then

EMSError($AC) (Ошибка в длине элемента) else {$endIF} begin

GetItem(X,Index) ;

LongIntItem := X end

•nd; {TEMSVector.LongIntItem} ^————————————;

Function TEMSVector.ByteItemfIndex: Longint): Byte;

var

X: Byte;

begin {$IFNDEF NOTCHECK]

if ItemSoSizeOf(Byte) then

EMSError($AC) (Ошибка в длине элемента} else {$endIF} begin

GetItem(X,Index) ;

ByteItem := X end end; /r.EMSVector.ByteIteni;

{---------- Двумерный массив в EMS -—--—---}

Constructor TEMSMatrix.Init(ASize,Minl,Maxl,Min2,Max2: Longint);

(Создает объект TEMSMatrix:

ASize - размер элементов массива а байтаи;

Mm,Max - границы индекса.) var

Sz: Longint;

begin

if (Minl>Maxl) or (Min2>Max2) then begin

SMSError($AB); (Неправильные границы} Exit end;

(Преобразуем к одномерному массиву от 0} Sz := (Maxl-Minl+l)*(Max2-Min2+l)-l;

TEMSVector.Init(Asize,0,Sz);


h0357.htm

if not EMSErrorFlag then begin

MinIndl :° Mini;

Maxindl :» Maxi;

MinInd2 :° Min2;

Maxlnd2 := Max2 end

end; f TEMSMatrix.Init} {— ——__———__——_;

Constructor TEMSMatrix.Load(var F: File);

{Создает объект TEMSMatrix - читает из файла объект TEMSVector, затем заголовок и поля MinIndl, Maxlnd.1, Minlnd2, Maxlnd2} var

S: String;

begin

TEMSVector.Load(F); {Загружаем из файла объект-родитель} if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSMatrix))

and (S-RegHeadTEMSMatrix) then begin

if ReadFile(F,MinIndl,4) and ReadFile(F,MaxIndl,4) and ReadFile(F,Minlnd2,4) then ReadFile(F,Maxlnd2,4) ;

if EMSErrorFlag then

Done end else

EMSError($A6) end; {TEMSMatrix.Load} _•————————————/

Procedure TEMSMatrix.Store(var F: File);

{Сохраняет вектор в файле - сначала сохраняет родительский объект TEMSVector, потом заголовок и поля MinIndl, Maxindl, Minlnd2, Maxlnd2} begin

TEMSVector.Store(F) ;

if not EMSErrorFlag then begin

if WriteFile(F,RegHeadTEMSMatrix,SizeOf(RegHeadTEMSMatrix)) then if WriteFile(F,MinIndl,4) then if WriteFilefF,Maxindl,4) than if WriteFile(F,Minlnd2,4) then

WriteFile(F,MaxInd2,4) end

end; {TEMSMatrix.Store) ^————————————;

Function TEMSMatrix.GetVecIndex(Indl,Ind2: Longint): Longint;

{Преобразует индексы двумерного пассива к индексу одномерного от 0} begin

EMSErrorFlag := False;

{$IFNDEF KOTCHECK}

if <Indl>MaxIndl) or (IndKMinIndl) or (Ind2>MaxInd2) or (Ind2<MinInd2) then

EMSError($AB) {Неправильный индекс} else {$endIF}

GetVecIndex := (Indl-MinIndl)*(MaxInd2-MinInd2)+Ind2-MinInd2 end; {TEMSMatrix.GetVecIndex} ^————————————;


h0358.htm

358 __ ___ Приложение

Procedure TEMSMatrix.SetItem(var Source; Indl,Ind2: LongInt);

{Помещает в EMS элемент с индексами Indl, Ind2 из переменной Source} var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2);

($IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIFj

TEMSVector.SetItem(Source,Item) end; {TEMSMatrix. Setltem} ^___—____-_____-. ___^

Procedure TEMSMatrix.Getltem(var Dest; Indl,Ind2: LongInt);

(Читает из EMS элемент ыассивас индексами Indl,Ind2} var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$end.IFf

TEMSVector.Getltem(Dest,Item) end; {TEMSMatrix.Getltem} ^—————————————;

Function TEMSMatrix.SingleItemtIndl,Ind2: LongInt): Single;

var

Item: LongInt; , begin

Item := GetVedndex (Indl, Ind2 );

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

SingleItem := TEMSVector.SingleItem(Item) end; {TEMSMatrix.SingleItem} ^_—————————.——;

Function TEMSMatrix.DoubleItem(Indl,Ind2: LongInt): Double;

var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

DoubleItem := TEMSVector.DoubleItem(Item) end; {TEMSMatrix.Doubleltem} ^————————————^

Function TEMSMatrix.Real Item(Indl,Ind2: LongInt): Real;

var

Item: LongInt;

begin

Item := GetVedndex (Indl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then ($endIF)

RealItem := TEMSVector.RealItem(Item) end; {TEMSMatrix.RealItem} ^——-——————————;

Function TEMSMatrix.Extendedltem(Indl,Ind2: LongInt): Extended;

var


h0359.htm

item: Longint;

begin

Item := GetVecIndex(Indl,Ind2);

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

ExtendedItem := TEMSVector.ExtendedItem(Item) end; {TEMSMatrix.ExtendedItem} ^———————————;

Function TEMSMatrix.IntegerItem(Indl,Ind2: Longint): Integer;

var

Item: Longint;

begin

Item := GetVecIndexdndl, Ind2) ;

f$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

Integerltem := TEMSVector.Integerltem(Item) end; {TEMSMatrix.Integerltem} {—— ————————— —}

Function TEMSMatrix.LongIntItemfIndl,Ind2: Longint): Longint;

var

Item: Longint;

begin

Item := GetVecIndexdndl, Ind2) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

LongIntItem := TEMSVector.LongIntItem(Item) end; {TEMSMatrix.LongIntItem} ^————————————;

Function TEMSMatrix.Byteltem(Indl,Ind2: Longint): Byte;

var

Item: Longint;

begin

Item := GetVedndex (Indl, Ind2) ;

{?IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

Byteltem := TEMSVector.Byteltem(Item) end; {TEMSMatrix.Byteltem} (--------- Многомерный массив в EMS ----------}

Constructor TEMSArray.Init(ASize: Longint; Hind: Word; var Ind);

{Создает объект TEMSArray: сначала создаетбазовый объект TEMSVector с индексом от 0, затем заполняет поле NInd, резервирует память для поля Index и заполняет его границами индексов} var

Indx: TIndexBond absolute Ind;

Sz: Longint;

k,j: Word;

begin

(Определяем общее количество Sz элементов массива:}

Sz := 0;

EMSErrorFlag := False;

for k := 1 to NInd do

if Indx[k,l]>Indx[k,2] then

EMSError($AB) else

Sz := Sz+Indx[k,2]-Indx[k,l]+l;


h0360.htm

360 .. -, _________ Приложение

if not EMSErrorFlag then begin

/Создаем базовый объект TEMSVector} TEMSVector.InittASize,0,Sz-1) ;

if not EMSErrorFlag then begin

GetMem(Index,NInd*12);

(Вычисляем множители каждого измерения и формируем список границ Index*}

Index*[NInd,З] :- I; (Младший индекс} Index^INInd,!] :- Indx[NInd,1];

Index^NInd^] := Indx[NInd,2];

for k := NInd-1 downto 1 do begin

Index* [k,l] :=• Indx[k,l];

Index^k^] :» Indx[k,2];

Sz :- 0;

for j :" k+1 to NInd do

Sz :- Зг+^аех^з^-Хг^ех'''^,!!*!)*!"^*!:]^];

Index* [k,3] :- Sz •nd;

MIndex :- NXnd end •nd

•nd; (TEMSArray.lnit) (,....-, -———————;

Destructor TEMSArray.Done;

(Уничтожает объект TEMSArray - уничтожает базовый объект TEMSVector и освобождает память Index"} begin

TEMSVector.Done;

FreeMem(Index,NIndex*12)

•nd; {TEMSArray.Done} ^—-—.—.——————;

Constructor TEMSArray.Load(var F: file);

{Загружает объект TEMSArray из файла S' - сначала загружает базовый объект TEMSVector, затем читает заголовок RegHeadTEMSArray, noneHIndex и список границ индексов} vac

S: String;

k,j: Integer;

begin

TEMSVector.Load(F);

if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSArray)) and

(S=RegHeadTEMSArray) and ReadFile(F,NIndex,2) then begin

GetMem(Index,NIndex*12);

for k :- 1 to NIndex do begin

ReadFile(F,Index*[k,1],4);

ReadFile (F, Index* [1с, 2], 4) ;

ReadFile(F.Index*[k,3],4) •nd;

it EMSErrorFlag then

Done end else begin


h0361.htm

EMSError($A6);

TEMSVector. Done and

end; {TEMSArray.Load} /————————————;

Procedure TEMSArray.Store(var F: File);

{Сохраняет объект TEMSArray в файле - сохраняет базовый объект TEMSVector, затем пишет заголовок, поле NIndex и список границ индексов} var

It: Word;

begin

TEMSVector.Store(F);

if not EMSErrorFlag then

if WriteFile(F,RegHeadTEMSArray,SizeOf(RegHeadTEMSArray)) and WriteFile(F,NIndex,4) then for k := 1 to NIndex do begin

WriteFile(F,bndex^[k,1],4) ;

WriteFile(F,Index"[k,2],4) ;

WriteFile(F,Index*[k,3],4) • end

end; {TEMSArray.Store} /-—————————— ——}

Function TEMSArray.GetVecIndex(var Ind): Longint;

{По текущим значениям списка индексов Ind вычисляет индекс для объекта TEMSVector} var

Indx: TIndexList absolute Ind;

N: Longint;

k: Word;

begin

EMSErrorFlag •.•=• False;

N := О;

for k :- 1 to NIndex do l$IFNDEF NOTCHECKf

if (Indx[k]<Index"[k,ll) or (Indx[k]>Index^[k,2]) then

EMSErrorFlag :•= True else {$end.IF}

N :» N+dndxtkl-Index^tk^jrindax^Ik.S];

i? EMSErrorFlag then

EMSError($AB) else

GetVecIndex :« N-1 end; {TEMSArray.GetVecIndex} ^_-_——————————;

Procedure TEMSArray.SetItem(var Source,Ind);

{Помещает значение Source в элемент многомерного массива} var

N: Longint;

begin

N := GetVecIndex(Ind) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then ($endIF}

TEMSVector.SetItem(Source,N) end; {TEMSArray.SetItem) ^-_————__——————_


h0362.htm

362 Приложение

Procedure TEMSArray.GetItem(var Dest,Ind);

(Возвращает в переменной Dest элемент многомерного массива} var

М: Longint;

begin

N := GetVecIndex(Ind) ;

{$IFNDEF NOTCHECK}

if not EMSErrorFlag then {$endIF}

TEMSVector.GetItem(Dest,N) end; ITEMSArray.Get Item}

{---- Имитатор файла последовательного доступа ----} Constructor TEMSType.Init(ASize: Longint);

{Создает объект TEMSType: сначала создает базовый объект TEMSArea, затем обнуляет поле Роз}

begin

TEMSArea.Init (ASize) ;

Pos := О

end; {TEMSType.Init} ^______-____-____-__;

Constructor TEMSType.Load(var F: File) ;

(Считывает объект TEMSType из файла F} var

S: String;

begin

TEMSArea.Load(F) ;

if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSType)) and

(S=RegHeadTEMSType) then ReadFile(F,Pos,4) else

Done

end; {TEMSType.Load} ^______——————___;

Procedure TEMSType.Store(var F: File);

{Записывает объект в файл} begin

TEMSArea.Store(F) ;

if not EMSErrorFlag and

WriteFile(F,RegHeadTEMSType,SizeOC(RegHeadTEMSType)) then

WriteFile(F,Pos,4) end; /TEMSType.Store} ^_-____________-__-./

Procedure TEMSType.Setltem(var Source; Sz: Longint) ;

{Записывает в ТЕМСТуре очередной элемент} begin

WriteEMS(Source,Pos,Sz) ;

if not EMSErrorFlag than

inc(Pos,Sz) end; {TEMSType.} ^_____——————_____;

Procedure TEMSType.Getlten(var Dcst; Sz: Lon^Int);

{Читает из TEMSType очс^гднгй элем"лт} begin

ReadEMS(Pos,Dest,Sz) ;

if not EMSErrorrlag then inc(Pos,Sz)


h0363.htm

end; {TEMSType.}

{------- Имитатор текстового файла --------}

Procedure TEMSText.SetItemfS: String);

{Помещает в EMS-память (начиная с позиции Pos от ее начала) строку S) begin

TEMSType.SetItem(S,Length(S)+1) end; {TEMSText.SetItem} {— ——____-_———__/

Function TEMSText.GetItem: String;

{Читает из EMS-памяти очередную строку} var

L: Byte;

S: String;

begin

TEMSType.GetItem(L,l) ;

if not EMSErrorFlag then begin

s[0] := chr(L) ;

TEMSType.GetItem(S[l],L) ;

GetItem := S end else

GetItem := #26 end; {TEMSText.GetItem) {-------- Копия экрана в EMS-памяти --------}

Constructor TEMSScreen.Init;

{Создает объект - определяет текущий режим работы видеоадаптера и в зависимости от этого резервирует память нужного размера} var

Sz: Longint;

begin

{С помощью функции $F прерывания $10 определяем текущий режим работы экрана} with Reg do begin

ah :-= $F;

Ini:r($lO,Reg) ;

Mode := al end;

{Выбираем нужный размер памяти

1..7 - текстовые режимы или графика CGA,16 Кбай'г=1с

13,14 - имитация на EGA/VGA графики ССА,1б Кбайт^1с

15 - моно EGA 640х350, 28 Кбайт = 2 стр.

16 - цвет " " " ", 112 Кбайт = 7 стр.

17 - моно VGA 640х480, 38.4 Кбайт = 3 стр.

18 - цвет " " " ", 153.6 Кбайт - 10 стр.} case Mode of

1..7,13..14 : Sz := LPage;

15: Sz := 2*LPage;

16: Sz := 7*LPage;

17: Sz :- 3*LPage;

18: Sz := 10*LPage else

Sz := 24*LPage {Для SVGA} end;

TEMSArea.Init(Sz) end; {TEMSScreen.Initf /——_—————————;

Constructor TEMSScreen.Load(var F: File);

(Читает объект из файла}


h0364.htm

var

S: String;

begin

TEMSArea.Load(F) ;

if not EMSErrorFlag then

if ReadFile(F,S,SizeOf(RegHeadTEMSScreen))

and (S=RegHeadTEMSScreen) then ReadFile(F,Mode,1) else

Done

end; {TEMSScreen.Load} (•-.-.———————————}

Procedure TEMSScreen.Store(var F: File) ;

{Сохраняет объект в файле} begin

TEMSArea.Store(F) ;

if not EMSErrorFlag then

if WriteFile(F,RegHeadTEMSScreen,SizeOf(TEMSScreen)) then WriteFile(F,Mode,1)

end; {TEMSScreen.Store} _•—————————_——__

Procedure TEMSScreen.PutScreen;

{Записывает в EMS-лаиять копию экрана} var

x,y,xx,yy,dy: Integer;

Pag: Byte;

EMS,Video: Pointer;

begin

{Проверяем текущий видеорежим} with R-eg do begin

ah := $F;

Intr($lO,Reg) ;

if aloMode then {Режим соответствует Mode?} begin (Нет - сообщаем и выходим} EMSError($AD) ;

Exit «id end;

(Копируем видеопамять в зависимости от режима} EMS :» ptr(EMSS,0); {Начало EMS} case Mode of

1..6,13..14: {Текстовые режимы всех адаптеров,

кроме MDA, графика CGA или ее имитация:

начало видеопамяти в $В800, длина до 16 Кбайт} begin

Video := Ptr($B8OO,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveFromScreen (Video^EMS^yLPage) end;

7: {Текстовый режим MDA: начало видеопамяти в $ВООО, длина 4 Кбайт) begin

Video := Ptr($BOOO,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveFromScreen(Video,EMS,Lpage div 4) end;

else {Остальные: дисплеи: предполагается, что


h0365.htm

Тексты программ 365

это EGA, VGA или SVGA в графическом режиме) begin

х := 0; (Левый верхний...} хх := GetMaxX; {угол экрана} у ;= 0; (Правый нижний угол} УУ := 0;

Рад := 0; (Номер началььой страницы EMS}

(Определяем количество dy полных строк экрана, которые еще умещаются в памяти одной страницы EMS}

while (ImageSize(х,у,хх,yy)<LPage) and (yy<=GetMaxY) do inc(yy);

dy := yy-1;

/Основной цикл сохранения копии блоками по 16 К) repeat

(Картируем страницу окна} MapEMSPage(Handle,0,Рад) ;

(Получаем копию части жрана} if y+dy<-GetMaxY then

GetImage(x,y,xx,y+dy,EMS^) else

GetImage(x/y,xx,GetMaxY,EMS");

inc(Рад) ;

inc (y,dy) until y>=GetMaxY end end {case Mode} end; {TEMSScreen.PutScreen} ^————-.————————;

Procedure TEMSScreen.GetScreen;

(Получает из EMS-памяти копию экрана} var

х,у,хх,yy,dy: Integer;

Рад: Byte;

EMS,Video: Pointer;

begin

(Проверяем текущий видеорежим} with Reg do begin

ah := $F;

Intr($lO,Reg) ;

if aloMode then (Режим соответствует Mote'?} begin (Нет - сообщаем и выходим} EMSError($AD);

Exit end end;

(Переносим копию а видеопамять в зависимости от режима} EMS := ptr(EMSS,O); (Начало EMS} case Mode of

1..6,13..14: (Текстовые режимы всех адаптеров,

кроме MDh, графика CGA или ее имитация:

начало видеопамяти в $В800, длина до 16 Кбайт} begin

Video := Ptr($B800,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveToScreenfEMS^Vidao^LPage) end;

7: (Текстовый режим MDA: начало видеопамяти в $ВООО, длина 4 Кбайт) begin


h0366.htm

366 Приложение

Video := Ptr ($BOOO,0) ;

MapEMSPage(Handle,0,0) ;

if not EMSErrorFlag then

MoveToScreen(EMS,Video,LPage div 4) end;

else {Остальные дисплеи: предполагается,

что это EGA, VGA или SVGA. в графическом режиме} begin

х :° 0; {Левый верхний...} хх := GetMaxX; {угол экрана) у :=• 0; {Правый нижний угол} уу := 0;

Рад := 0; {Номер начальной страницы EMS} (Определяем количество dy полных строк экрана, которые еще умещаются в памяти одной страницы EMS} while (ImageSize(х,у,хх,уу)<LPage) and (yy<=GetMaxY) do inc(yy);

dy := yy-1;

{Основной цикл восстановления экрана блоками по 16 К} repeat

{Картируем окно} MapEMSPage(Handle,0,Рад) ;

(Переносим копию части экрана} PutIniagetXfyiEMS^NornialPut) ;

inc(Рад) ;

inc (y,dy) until y>=GetMaxY end

end (case Mode} end; {TEMSScreen.GetScreen} {----—--—-- Интерфейс с EMM ------------)

Procedure Intr67;

{Реализует прерывание $67 и устанавливает флаг EMSStatus} begin

Intr($67,Reg) ;

EMSStatus := Reg.ah end;

^———————————;

Function IsEMS: Boolean;

{Возвращает TRUE, если в ПК имеется EMS-память} const

Name: array [1..9] of Char = 'EMMXXXXO'#0;

label Exit;

begin

if EMSVer=0 then with Reg do {Была проверка раньше?}

begin {Нет - проверяем установку EMM} ah :° $3D; {Создаем дескриптор файла} а1 :^ 0; {Для чтения} dx := Ofs(Name); {С именем "EMMXXXXO"} ds := Seg(Name) ;

MSDOS(Reg) ;

{Если файла нет - EMM не установлен} if (Flags and FCarry)<>0 then Goto Exit;

(Проверяем статус файла}

bx :== ax; {Дескриптор файла}

ah := $44; {Запрос IOCTL}

al :== 7; (Дать статус файла)


h0367.htm

MSDOS(Reg) ;

if ((Flags and FCarry)<>Q) or (al=0) then Goto Exit;

ah := $46; {Получаем номер версии EMM} Intr67;

if EMSStatus~0 then {Если ошибка - нет EMM} begin

EMSVer :« al; {Сохраняем номер версии} ah := $41; {Получаем сегмент окна} Intr67;

EMSS := Ьх (Сохраняем сегмент} end end;

Exit:

IsEMS := EMSVerOO end; {IsEMS} (— —____—_____——}

Function GetEMMVersion: String;

{Возвращает номер версии EMM в формате 'Х.Х'} var

s,ss: Strings-begin

if EMSVer=0 then if IsEMS then;

Str (EMSVer shr 4,s);

Str(EMSVer and $F,ss);

GetEMMVersion := s+'.'+ss end;

^———————————;

Function EMSSeg: Word;

{Возвращает сегментную часть адреса "окна" EMS-памяти} begin

if EMSS=0 then if IsEMS then;

EMSSeg := EMSS end; {EMSSeg! {,—, —————————}

Procedure GetEMSInfo(var AllPage, Pages: Word);

/'Возвращает полное количество (AllPages) и количество незанятых (Pages) страниц} begin

if IsEMS then with Reg do begin

ah :=$42;

Intr67;

AllPage := dx;

Pages := bx end else begin

AllPage := 0;

Pages := 0 end end; {GetEMSInfo} ^————————————;

Procedure NewEMSHandle(var Handle: Word;Pages: Word) ;

{Открывает новый дескриптор Handle и связывает с ним Pages страниц EMS} begin

it IsEMS then with Reg do


h0368.htm

begin

ah :- $43;

bx := Pages;

Intr67;

Handle :== dx end end; {NewEMSHandle} _— ———————— ——)

Procedure DisposeEMSHandle(var Handle: Word);

{Удаляет дескриптор Handle и освобождаетсвяэаннугэ с ним память} begin

it IsEMS then with Reg do begin

ah := $45;

dx :=• Handle;

Intr67 end

end; {DisposeEMSHandle} /————————————;

Procedure MapEMSPage(Handle,Physic,Logic: Word);

{Картирует окно, связывая его Physic физическую страницу с Logic логической страницейдескриптора Handle} coast

OIdH: Word-$FPFP; {Параметры...}

OldL: Word-$FFFF; {предыдущего...}

OldP: Word=$FFFF; {обращения к процедуре) begin asm

{Проверяем параметры обращения: если они не менялись, значит контекст страниц сохранился и можно не картироватъ)

mov ax,Physic {AX := Physic}

mov bx,Logic BX := Logic}

mov dx,Handle {DX := Handle}

cmp ax,OldP {Physic=01dP ?}

jne @do {Нет - изменилась физ.стр.}

cmp bx,01dL {Logic-OldL ?}

3ne @do {Нет - изменилась логич.стр.}

cmp dx,01dH (Handle^OIdH ?}

js @Exit {Да - параметры не менялись,

не нужно картироватъ, еще раз} @do: {Параметры изменились - картируем:}

mov 01dP,ax {Сохраняем...}

mov 01dL,bx {новые...}

mov 01dH,dx {параметры}

mov ah,$44 {Код функции для картирования}

int $67 {Картируеы}

mov EMSStatus,ah {Новый статус EMS} @Exit: end;

end; {MapEMSPage} ^==^==»-,=====/ end. /Unit F_EMS} /e======».=====;

П7. МОДУЛЬ F_ANTI ДЛЯ ЗАЩИТЫ ПРОГРАММ ОТ ВИРУСОВ

Описание модуля см п.6.3.3.

^==»»=======с»»=; aMIT F_Anti; (=-»«============)

_•+.——————————————————+

I Модуль содержит программу контроля возможного ¦


h0369.htm

Тексты программ ______ ___________ _______ 369

I заражения исполняемого ЕХЕ-файла компьютерным I вирусом. Эталонный заголовок файла и его длина запоминаются при первом запуске программы

в типизированной константе HEAD. Если факт

заражения установлен, программа сообщает об

этом, переносит копию на место испорченного

вирусом заголовка файла и восстанавливает

длину файла. +——————————————————————————„———+^

INTERFACE var

CheckVirusResult: Integer;

{Результат работы программы:

sss 0: вирус не обнаружен;

= 1: установлена защита файла;

—1: вирус удалей с разрешения пользователя/

=-2: вирус удален автоматически;

=-3: контроль блокирован ключом /NOANTI;

sa-4: вирус расположен в начале файла, удаление невозможно}

IMPLEMENTATION Uses DOS, CRT;

var

fff: file;

Procedure CheckFile;

type

{Заголовок ЕХЕ-файла}

HeadExeType = record case Byte of

0:t -• . , - ;

Sign : Word; {Сигнатура 'MZ' = $5A4Df

PartPag: Word; (Часть неполного сектора}

PageCnt: Word; {Количество секторов}^ -

ReloCnt: Word; {Количество элементов в таблице перемещения)

HdrSize: Word; (Длина заголовка в параграфах}

MinMem : Word; {Минимальный размер кучи)

MaxMem : Word; {Максимальный размер кучи)

ReloSS : Word; (Начальное значениесегмента стека SS)

ExeSP : Word; (Начальное значениуказателя стека SP!

ChkSum : Word; (Контрольная суммавсех слов файла)

ExelP : Word; {Смещение точкизапуска программы)

ReloCS : Word; (Начальное значениесегмента кода CS)

TablOff: Word; {Смещение таблицы перемещения}

Overlay: Word; (Номер оверлея (0 для главной программы!));

1: (Нет: array [1..14] of Word) end; (HeadExe)

{Ключ незараженного файла} KeyType = record

НЕ: HeadExeType; (Заголовок файла}

HL: LongInt; (Исходная длина файла}

HF: Boolean; (Флаг установки ключа)

• Key: Word (Ключ для шифровки} end;

s8 = String [81;

const

H: KeyType =

(НЕ: (Нет: (0,0,0,0,0,0,0,0,0,0,0,0,0,0));

HL: 0;

HF: False;

Key: 0);

Key: array [1..4] of s8 =

('/NOANTI','/NOQUERY','/NOALARM','/NOCOPY');


h0370.htm

var

f,ff: file;

Name: String;

NoAnti, NoQuery, NoAlarm, KoCopy: Boolean;

Offset: Word;

Head: KeyType;

Procedure AntiAIDS;

(Удаляет обнаруженный вирус} var

с: Char;

p: ^Byte;

Delta: Longint;

procedure WriteVirFile;

{Переписывает файл f в файл ff максимально возможными блоками} var

k,L: Longint;

p:"Byte;

begin

L := FileSize(f); {L - незаписанный остаток файла) repeat

k := MaxAvail;

if k > 65520 then k :- 65520;

if k > L then k := L;

GetMem(p,k); (k - длина буфера перезаписи} BlockRead(f, ?'',]<);

BlockHritefffrp^fk) ;

FreeMemtp,k);

dec(L,k) until L ° 0 end; {HriteVirFile}

Procedure FileInit;

(Создает резервную копию зараженного файла} begin

{Изменяем расширение файла на VIR:}

Name := copy(Name,1,pos('.'»Name));

Assign(ff,Name+'VIR') ;

Rewrite(ff,1); {ff - копия файла с расширением VIR}

Seek(f,0);

WriteVirFile; {Переписываем файл}

Close(ff) end; {FileInit}

coast

txtl="Вирус расположен в начале файла.';

txt2=' Удаление невозможно.';

txt3=tl3#10'Нажмите любую клавишу...';

begin {AntiAIDS} if not NoCopy then

FileInit; {Создаем резервную копию файла} if Head.HE.ReloCS > H.HE.ReloCS then

begin (Вирус в конце файла} (Восстанавливаем эталонный заголовок:} Seek(f,0);

BlockWrite(f,H.HE,SizeOf(H.HE));

{Воссганавливаек эталонную длину.}


h0371.htm

Seek(f,H.HL) ;

Truncate(f); {Отсека ем вирус) if NoAlarm or NoQuery then

CheclcVirusResult :» -2 {Удалей автоматически} else

CheckVirusResult := -1 {Удален с разрешения} end else begin

if not NoAlarm then begin

Write(txtl,txt2,txt3) ;

с := ReadKey;

if с = #0 then

с := ReadKey end;

CheckVirusResult := -4 {Вирус не удален} end end; {AntiAlDS} ^——..-————————^

Procedure Check;

(Осуществляет контроль заголовка файла) var

k: Byte;

s: String [1];

begin {Check}

CheckVirusResult := 0;

{Дешифруем ключ:} with H,H.HE do

for k := 1 to 14 do

Hem[k] := Hem[k] XOE Key;

{Проверяем заголовок:} k := 1;

while (CheckVirusResult=Q) and (k <» X4) do begin

if H.HE.Heatkl <> Head.HE.Hea[kl then CheckVirusResult := -1;

inc(k) end;

it CheckVirusResult "-I then begin (Обнаружен факс заражения}

if NoAlarm then

AntiAlDS else begin

WriteLn(1Файл 1,Name,' заражен вирусом!1#7) ;

if NoQuery then

AntiAlDS else begin

Write('Удалять вирус (У/М, умлч.Х)? ');

s := ' ';

ReadLn(s);

if (s=") OB (OpCasetstlDO'll")

then AntiAlDS else

CheckVirusResult :•• -3 end •nd


h0372.htm

end end; (Check) {.-. ——-.——————/

Procedure Save;

{Запоминает заголовок файла в константе HEAD} var

s: LongInt;

r: registers;

p: Pointer;

begin {Save}

with Head,Head.HE do begin

HL := FileSize(f); {Получаем длину файла}

HF :« True; {Устанавливаем признак контроля}

Г.АН :- $62;

MSDOS(r); {Получаем в г.ВХ сегмент PSP) р := @н;

s := round( (DSeg-r.BX-16+HdrSi2e)*16.0)+ofs(p'');

{s - смещение ключа. Н от начала файла} end;

Seek(f,s); (Позиционируем файл на начало ключа) {Шифруем ключ:} Randomize;

Head.Key := Random($FPFF);

with Head,Head.HE do for s :° 1 to 14 do

Hem[s] := HE.Hem[s] xor Key;

{Запотнаем ключ в файле} BlockWrite(f,Head,SizeOf(H)) ;

CheckVirusResult := 1 end; {Save}

{,., —————.——————— ———J

Function UpString(s: String): string;

{Преобразует символы строки S в верхний регистр/ var

k: Byte;

begin {UpString}

for k := 1 to Length(s) do s[k] :» UpCase(s[k]) ;

UpString := s end; {OpStringj ^-——————————;

Procedure GetParams;

(Получить параметры запуска! var

k,j: Byte;

begin

(Анализ ключей команды запуска:} NoAnti :° False;

NoQuery := False;

NoAlarm := False;

Noi-opy := False;

for к :- 1 to ParamCount do for j := 1 to 4 do

if UpString(ParamStr(k)) = Key[j] then case j of

ч: NoAnti := True;

2: NoQuery := True;

3: NoAlarm := True;


h0373.htm

4: NoCopy := True end;

end; (GetParamsf begin {CheckFile}

Name := ParamStr(O); {Name содержит полное имя файла) GetParams; {Получаем параметры вызова} if NoAnti then

CheckVirusResult :=—3 else begin

Assign(f,Name);

Reset(f,l); _ {Длина блока равна 1 байт} BlockRead(f,Head,SizeOf(H)); {Читаем заголовок файла} if H.HF then

Check {Проверяем заголовок файла} else

Save; {Запоминаем заголовок} Close(f) end end; {CheckFile} { Все действия осуществляются установочной частью модуля:

} begin

CheckFile end. (F_Antl)

П8. КОМПЛЕКС ПРОГРАММ SETFAG.PAS/FAG.ASM П8.1. Установщик фага SetFag.pas

Описание программы см. п. 6.4.1.

/

Эта программа устанавливает автономный антивирус-фаг на любой ЕХЕ-файл или

группу файлов. Код антивируса берется из файла FAG.PRG (или загрузочной част

любого другого ЕХЕ-файла). Формат обращения:

SetFag <EXE> [/F:<FAG>] [/NOBAK]

<ЕХЕ> - имя защищаемого ЕХЕ-файла (допускается групповое имя с использованием "*" и "?"; можно указать маршрут поиска; по умолчанию назначается расширение ЕХЕ) ;

<FAG> - имя ЕХЕ-файла с кодом фага; если ключ не задан, код берется из файла FAG.PRG

Ключ /NOBAK блокирует создание резервных копий защищаемых файлов (с расширением ВАК) .

}

Uses F_Anti,DOS;

const

LT » 63; {Длина строк сообщения}

NT - 20; (Количество строк сообщения}

Text: array [I..NT] of String [LT] °(

'Эта программа устанавливает автономный антивирус-фаг на любой',

'ЕХЕ-файл или группу файлов. Код антивируса берется из файла',

'FAG.PRG (или загрузочной части любого другого ЕХЕ-файла). ',

'Формат обращения:",

' SetFag <EXE> [/F:<FAG>] [/NOBAK]',

'<ЕХЕ> - имя защищаемого ЕХЕ-файла (допускается групповое имя',

' с использованием "*" и "?"; можно указать маршрут по-',

' иска; по умолчанию назначается расширение ЕХЕ);',


h0374.htm

3f4'_____________ _ _____________.....__.. .„.. ___..„._„ „_ ..„PPM0*81*^

'<FAG> - имя ЕХЕ-файла с коДом фага; если ключ не задан» Код',

' берется из файла FAG.PRG;',

'Ключ /NOBAK блокирует создание резервных копий защищаемых фай-',

'лов (с расширением ВАК).',

'Примеры:',

' eetfag ffiyprog'^

'Файл MYPROG.EXE будет содержать защищенную программу,MYPROG.ВАК',

'- исходную. Код фага будет взят из файла FAG.PRG',

' setfag d:\dir\* /nobak /f:myfag.exe',

•Защищаются все ЕХЕ-файлы из каталога D:\DIR, резервные копии не',

' создаются, код фага берется из MYFAG.EXE.',

' (С) В.В.Фаронов, 1992');

type

HeadType » record case Byte of 1: (

Sign : Word? {Сигнатура 'MZ' - $5A4D)

PartPag: Word; fVaoa'b йвпалного сектора}

PageCnt: Word; {Количество секторов)

ReioCnt: Word; (Количество элементов в таблице перемещения)

HdrSize: Word; {Длина заголовка в параграфах)

MinMem : Word; (Минимальный размер кучи)

MaxMem : Word; {НаксчмальныЯ рааивр кучи)

Re^oSS : Word; {Начальное значение сегмента стека SS}

ExeSP : Word; {Начальное значение указателя стека SP)

ChkSum : Word; {Контрольная сумма всех слов файла)

ExelP : Word; {Смещение точки запуска программы)

ReloCS : Word; (Начальное значение сегмента кода CS)};

2:W: array [1..12] о- Word) end;

ТКеу = record

Head.24: HeadType; {24 байта эталонного заголовка) Starts: Word; (OTHOWt'enlstaM сёТиент} StartO: Word; (и смещение точки запуска программы) Leng24: LongInt; {Длина незараженной программы минус 24 байта) Key : Word; {Клвч гжфрваки) end;

ByteArr = array [l..Max!nt] of Bytey var

H,HFag: HeadType;

HH : TKey;

fe, {ЕХЕ-файл} ft: file; (Файл с кодой фага} LFag: LongInt; {Длина кода фага) CFag: ^ByteArr; (Указатель на код фага} NE: String; (Имя исходного ЕХЕ-файла} NF: String; (Имя файла с кодом фага) S: SearchRec;

d: DirStr;

n: NameStr;

e: ExtStr;

LS: LongInt; {Смещение для фага} const

FagName = 'Fag.pre'; (Имя файла-фага BakFile : Buolean ~ True; (Признак ВАК-файлов} f., —————_-——-——;

Procedure Help;

{Выводит справку об использовании программы и завершает работу) const

Bord = 14;

var


h0375.htm

к: Integer;

begin

for k := 1 to LT+Bord+1 do Write ('*');

WriteLn;

for k := 1 to NT do

WriteLn('*',' ':Bord div 2,

Text[k],1*1:LT+Bord div 2-Length(Text[k])) ;

for k := 1 to LT+Bord+1 do HriteC*') ;

WriteLn;

Halt

end; {Help} /————————————;

Procedure CheckParam;

{Проверяет параметры вызова и дает диагностику, если не задано имя защищаемого файла} var

k: Integer;

s,n,e: String;

Function UpStringts: String): string;

var

k: Integer;

begin

for k := 1 to Length(s) do s[k] := UpCase(s[k]);

UpString := s end; {UpString} begin {CheckParam} NE : = " ;

NF :== FagMame;

for k :° 1 to ParamCount do begin

s := UpString(ParamStr(te));

if s='/NOBAK" then

BakFile := False else

if pos C/F:',s)<>0 then

NF := copy(s,4,Length(s)-3) else

if NE='' then

NE := S else begin

WriteLn <'Ошибка в обращении') ;

Help end end;

if NE = '' then Help;

if pos (' : ',NF)=0 then

begin {He указан путь к фагу} s := ParamStr(0) ;

FSplit(s,s,n,e) ;

NF := s+NF {Взять путь к SetFag} end end; {CheckParam} ^————————————;

Procedure NotAccessis: String);


h0376.htm

{Выводит сообщение 'Нет доступа...' и справку} begin

WriteLn('Нет доступа к файлу ',s);

Help

end; {NotAccess} ^————————-.. ..„^

Function CheckReadfs: String; k,n: Word):Boolean;

(Проверяет корректность чтения и дает сообщение, если требуемое количество К байт не равно прочитанному N байт} begin

if kon then begin

WriteLn('Ошибка чтения из файла ',s);

CheckRead := False end else

CheckRead :°= True end; {CheckRead} ^————————————;

Function CheckWrite(s: String; k,n: Word): Boolean;

{Проверяет корректность записи и дает сообщение, если требуемое количество К байт не равно записанному N байт} begin

if kon then begin

WriteLn('Ошибка записи в файл ',s);

CheckWrite := False end else

Checktorite :=» True end; {CheckRead} /————————————;

Procedure OpenFag;

{Открывает файл-фаг и считывает его код в динамическую память} var

k: Word;

begin

Assign(ff,NF) ;

{$!-}

Reset (ff,l) ;

{$!+}

if IQResult <> 0 then NotAccess(NF) ;

BlockRead(ff,HFag,SizeOf(HFag),k) ;

if not CheckRead(NF,SizeOf(HFag),k) then Halt;

LFag := File3ize(ff)-HFag.HdrSize*16-SizeOf(TKey);

GetMem(CFag,LFag) ;

Seek(ff,FileSize(ff)-LFag),•

BlockRead(ff, СЕ-ад", LFag, k) ;

if not CheckRead(NF,LFag,k) then Halt;

Close(ff) end; {OpenFag} _•————————————/

Function CheckFile: Boolean;

{Проверяет возможность установки защиты и готовит новый заголовок файла} va.s

г: registers;

s: String [1];


h0377.htm

k: Word;

p: ^yteArr;

label

NotFag^ const

ЬхЫ"'Файл ';

txt2=' содержит оверлеи, архив или отладочную информацию.';

begin

CheckFile := False;

BlockRead(fe,H,SizeOf(H),k); {Читаем заголовок} if not CheckRead(NE,SizeOf(H),k) then

goto Not Fag; {Ошибка чтения} if H.Sign <> $5A4D then begin

WriteLn('Файл ',NE,' не является ЕХЕ-программой!');

NotFag:

WriteLn('Защита не установлена');

Exit end else begin

if FileSize(fe)-H.HdrSize*16>LFag then {Проверяем и блокируем повторную защиту} begin

GetMem(p,LFag);

Seek(fe,FileSize(fe)-LFag) ;

BlocltReadffetp^LFag,k) ;

k := LFag div 2; {Сравниваем, начиная с середины кода} repeat

inc (k) until (k>LFag) or (p" [k] OCFag^ [k] ) ;

FreeMem(p,LFag) ;

if k > LFag then begin

WriteLn('Файл ',NE,' уже защищен!');

Exit end end;

{Проверяем размер программы}

Intr($12,r); {Получаем объем памяти} LS := FileSize(fe)+LFag+SizeOf(HH)+15;

if r.AX*lO24.0-LS-H.MinMem*16 <= 0 then begin

WriteLn('Файл ',NE,' слишком велик!') ;

goto NotFag end;

if (FileSize(fe)+15) div 16>H.PageCnt+H.HdrSize then begin

WriteLn(txtl,NE,txt2) ;

Write('Устанавливать защиту (У/М,умлч.У)? ');

ReadLn(s);

if s»1 ' then s : - ' Y ' ;

if UpCase(s[l]) = 'N' then

goto NotFag end;

HH.Head24 := H;

with HH,HH.Head24 do


h0378.htm

begin

Starts := ReloCS;

StartO := ExelP;

ExelP := HFag.ExelP;

LS := (FileSize(fe)+15) div 16;

ReloCS := LS-HdrSize;

Leng24 := LS*16+LFag+SizeOf(HH)-24;

PageCnt := (Leng24+24+511) div 512;

PartPag :- (Leng24+24) mod 512;

if MinMem < 256 then MinMem :» 256;

if ExeSP < 4096 then ExeSP := 4096;

CheckFile := True end end end; {CheckFile} _•————————————;

Function CorrectName: Boolean;

(Определяет имя очередного защищаемого файла и открывает его} const

FirstName: Boolean = True;

begin

if FirstName then begin

FirstName := Falser-if post'.',NE)=0 then NE := NE+'.exe';

FSplit(NE,d,n,e) ;

FindFirst(NE,$2F,S) ;

if DOSErroroO then

NotAccess(NE) end else

FindNext(S);

if DOSError=0 then begin

NE := d+S.Name;

Assign(fe,NE);

{$!-} Reset(fe,l);

{$!+} if lOResult о 0 then NotAccess(NE) ;

CorrectName := CheckFile;

end else

CorrectName :» False;

end; (CorrectName} {.. —.—————————;

Procedure SetVirFag;

{Устанавливает защиту} vac

p: Pointer;

s: Word;

n: String;

L: Longint;

k: Word;

fb: file;


h0379.htm

fff: file;

LOld: Longint;

label

NotBack,NotFag;

begin

LOld := FIleSize(fe); {Запоминаем ffvapya длину файла) if BakFile then begin

n :- copy(NE,l,pos('.',ME))+'BAK';

Assign(fb,n);

l$I-l Rewrite(fb,l) ;

{!+}

if lOResult <> 0 then NotBack:

WriteLn(1Невозможно соэдать резервную копию ',п) else begin

Seek(fe,0) ;

L := LOld;

repeat

s := 65520;

if L < s then s := L;

if MaxAvail < s then s :•= MaxAvail;

GetMemfp, s);

BlockReadtfetp^tStk);

if not CheckRead(NE,s,k) then Exit;

BlockWriteffb.p^tS.k);

if not CheckWrite(n,s,k) then goto NotBaek;

FreeMem(p,s);

dec(L,s) until L=0;

Close(fb) end end;

Seek(fe,0);

BlockWrite(fe,HH,SizeOf(H),k); (Пишем новый заголовок} if CheckWrite(ne,SizeOf(H),k) then begin

Randomize; (Инициируем генератор} HH.Key := Random($FFFF); (Получаем ключ} for k := 1 to 12 do with HH,HH.Head24 do

W[k] :° W[k] xor Key; (Шифруем заголовок} Seek(fe,LS*16); (Смещаем на границу параграфа} (Записываем ключ} BlockWrite(fe,HH,SizeOf(НН),k) ;

it CheckWrite(ne,SizeOf(HH),k) then begin

(Записываем фаг} Bloc]<Write(fe,CFag'',LFag,k) ;

if CheckWrite(ne,LFag,k) then

HriteLn(NE,' защищен') else

goto NotFag end


h0380.htm

else

NotFag:

{Ошибка записи в конце ЕХЕ-файла. Восстанавливаем его:} begin

Seek(fe,0);

BlockWrite(fe,H,SizeOf(H)) ;

Seek(fe,L01d) ;

Truncate(fe) end;

end;

Close(fe) end; {SetVlrFag} /————————————;

begin

CheckParam; {Проверяем параметры обращения}

OpenFag; {Открываем файл-фаг}

while CorrectName do {Получаем имя очередного защищаемого файла}

SetVirFag {Устанавливаем защиту) end.

П8.2. Фаг Fag.asm

Ниже приводится текст фага, устанавливаемого на ЕХБ — файлы для защиты их от вирусов. Для большей наглядности пояснения вкраплены в тело программы, но не выделены обязательным знаком комментария, в качестве которого в ассемблерных программах используется точка с запятой. Поскольку эти пояснения набраны с отступом от левого края листа, я думаю, Вы сможете их легко отличить и при повторении программы либо не включите эти пояснения в ассемблерную программу, либо оформите их надлежащим образом.

CSEG SEGMENT PARA PUBLIC 'CODE'

VirCheck PROC FAR

ASSUME CS:CSEG,DS:CSEG,S3:CSEG

; Следующие 17 слов готовятся программой-инсталлятором:

Head dw 12 dup(?) ;Зашифрованный ключ Starts dw ? Относительный сегмент StartO dw ? и смещение точки запуска Lengi dw ? Эталонная длина минус

24 байта - младшая часть Leng2 dw ? и старшая часть Key dw ? шифр ключа

; Константы и переменные ;

; ————————-—————;

PSP dw ? Сегмент PSP CSO dw ? Сохранение CS SPO dw ? Сохранение SP NameFE db 80 dup(?) ASCIIZ-имя ЕХЕ-файла NameF$ db 80 dup(?) ASCIIZ-имя $У$-файла NameFV db 80 dup(?) ASCIIZ-имя VIR-файла Buffer equ Word ptr NameF$ LName dw ? Длина имени без учета

расширения и нуля HandExe dw 0 Описатель ЕХЕ-файла TxtO db 13,10,'$' EOL Txtl db ^ 'Файл $'

Txt2 db ' заражен вирусом!',13,10,'$' Txt21 db 'Вирус поразил начало файла'

db ' - удаление невозможно!',13,10 Txt20 db 'Нажмите любую клавишу...$' Txt22 db 'Удалять (У/Я,умлч.У) ?$'


h0381.htm

Тексты программ. 381

Vir db 'VIR',0

Ext$ db '$V$',0

HandVir dw 0

Txt3 db 'Ошибка доступа к файлу',

db 13,10,'$'

Txt4 db 'Вирус удален. Проверьте '

db 'другие файлы!',13,10,'$'

Mem dw ? ;Размер буфера

MemS dw ? ;Сегмент буфера

MemF dw 0 ;Признак распределения памяти

Основная программа

START:

push ax Спасаем AX mov ax,ds Запоминаем сегмент PSP mov bx,sp и указатель стека push cs Назначаем сегмент данных pop ds равным сегменту кода mov CSO,ds Сохраняем CS mov PSP,ax Спасаем DS = PSP mov SPO,bx Спасаем SP add ax,10h Сегмент начала программы add ax,Starts Сегмент точки запуска mov Starts,ax Готовим выход call GetExeName Получаем имя ЕХЕ-файла call ReadHead Читаем е^о заголовок call CheckHead Проверяем заголовок je Exit Кончаем, если норма call Dialog Сообщаем и запрашиваем je Exit Пользователь запретил удаление call NewFile Создаем $У$-файл call WriteHead Пишем в него эталонный заголовок call CopyFile Копируем незараженную часть call Rename Переименовываем файлы

Выход EXIT:

Выход из фага и передача управления защищаемой программе (метка EXIT) осуществляется следующим образом. Вначале фаг вызывает процедуру ClosePUes, чтобы закрыть все открытые файлы (файл считается открытым, если соответствующий ему дескриптор не равен 0). Затем вызывается процедура FreeMem, в которой контролируется размер MemF памяти, зарезервированной под буфер перезаписи с помощью функции ДОС $48. Если MemF не равна 0, фаг возвращает ДОС блок памяти длиной MemF байт. Перед завершением работы из стека извлекается значение регистра AX, a в регистры D5 и ?5 помещается значение сегмента PSP. Собственно передача управления осуществляется стандартным для ДОС образом: в стек заталкивается сегмент и смещение точки запуска программы, затем выполняется команда дальнего выхода из подпрограммы RETF. Эта команда извлекает два слова из вершины стека и помещает их в регистры IP и CS.

call CloseFiles Закрываем открытые файлы

call FreeMem Возвращаем зарезервированную память

mov sp,SPO Восстанавливаем SP

mov bx,Starts Готовим сегмент

mov cx,3tart0 и смещение точки запуска

mov es,PSP Восстанавливаем ES

mov ds,PSP Воссганавливаем DS

pop ax Восстанавливаем AX

push bx

push ex


h0382.htm

retf ;Передаем управление программе ; Процедуры;

GetExeName PROC NEAR

; Анализируем окружение ДОС, выделяем ; имя программы и копируем его в буфер NameFE

Процедура GetExeName отыскивает имя программы в окружении ДОС и переносит его в переменную NameFE. Если имя выделить не удалось (не найдены два последовательных нуля в буфере длиной 1000 байт или количество переменных в расширенной части равно 0)i фаг не может определить местоположение и имя защищаемой файла — в этом случае он просто завершает свою работу и без каких-либо сообщений передает управление защищаемой программе. Таким образом, непременным условием работоспособности фага является использование версии ДОС 3.0 и выше. Фактически все, что делает процедура GetExeName, реализуется единственной строкой на Турбо Паскале:

NameFE := PararnStr (0);

Полезно взглянуть на реализацию GetExeName, чтобы лишний раз оценить преимущества использования современных языков программирования высокого уровня.

mov es,PSP ES = PSP

mov es,es:[2Ch] ES - сегмент окружения ; Ищем начало дополнительнык параметров

mov сх,1000 Ищем в буфере

длиной 1000 байт

mov Ьх,-1 Начинаем с первого байта SEARCH:

inc bx Текущий байт

mov ax,es:[bx] Текущее слово

стр ах, 0 Ищем два нуля

jz EndSearch Переходим, если нашли

loop Search Повторяем для следующего байта

jmp Exit He найдено имя - выходим! ; Переносим имя файла endSEARCH:

add bx,2 Смещение количества параметров

mov ax,es:[bx] Получаем количество параметров

crop ax,0 Есть параметры?

je Exit Нет, выходим

add Ьх, 2 Начало имени

lea di,NameFE Индекс копии

mov сх,0 Готовим счетчик длины LAB1:

mov ah,es:[bx] Очередной символ

mov [di],ah Переносим его

inc bx Наращиваем указатели

inc di

inc сх и счетчик

cmp ah,О

jnz Labi Повторяем до символа О

add сх,-4 СХ - длина имени без расширения и нуля

mov LName,cx

ret

ReadHead PROC NEAR

; Открываем ЕХЕ-файл, читаем из него заголовок


h0383.htm

Тексты программ 383

Процедура ReadHead открывает ЯХС—файл и читает его заголовок. В ней (как и всюду в фаге) используется метод доступа к файлам с помощью так называемых дескрипторов (описателей) файлов, файл открывается с помощью функции ДОС $3D, а заголовок читается функцией $ЗР.

; Открываем файл с именем в NAMEF

lea dx,NameFE Начало имени

mov ah,3Dh Код операции

mov al,0 Открываем для чтения

int 21h Обращаемся к DOS

jnc LabO Если нет ошибки

jmp Exit Выходим, если ошибка LABO:

mov HandExe,ax Сохраняем описатель файла ; Читаем заголовок файла

mov Ьх,ах ВХ - описатель файла

mov ah,3Fh Код операции

lea dx,Buffer DS:DX - адрес буфера

mov cx,24 Читаем 24 байт (заголовок)

int 21h

jnc п>0

jmp Exit Если ошибка m0: ret

CheckHead PROC NEAR

; Дешифруем ключ и проверяем заголовок файла

Процедура CheckHead расшифровывает эталонный заголовок Head и сравнивает его с только что прочитанным. Если нет отличий (в этом случае при выходе из процедуры флаг ZF=l), фаг закрывает ЯХЕ—фаил и запускает защищаемую программу. Если обнаружено отличие заголовка от эталона [ZF=0], вызывается процедура Dialog. В ней на экран выводится сообщение о факте заражения файла и проверяется расположение вируса в теле файла. Если относительный сегмент точки запуска зараженной программы ReloCS меньше, чем в эталоне, значит вирус пристыкован в начало программы. В этом случае фаг сообщает о невозможности ликвидации вируса и завершает работу. Если ReloCS больше, чем в эталоне, вирус расположен в конце файла и его можно «выкусить». Фаг запрашивает согласие пользователя и, если оно получено, приступает к ликвидации вируса. ; Дешифруем ключ

mov сх,12 ;Счатчик повторений

lea bx,Head »BX - смещение эталонного заголовка LAB2:

mov ах,[Ьх] ?Берем очередное слово

xor ax,Ksy Дешифруем его

mov [Ьх],ах Помещаем назад

add bx,2 Переходим к следующему слову

loop Lab2 Повторяем расшифровку ; Сравниваем заголовок с эталонным

mov сх,12 Длина заголовка в словах

mov es,cs0 ES - сегмент кода

lea si,Head Эталон

lea di,Buffer ;Заголовок

eld ;Направление - вперец repe cmpsb ;Сравниваем

ret

! ~ ———————— —-.———• ———————— ___—~_ ——__•._—_.••-—_—•. —_«.—

Dialog PROC NEAR

; Сообщаем пользователю о наличии вируса

; и запрашиваем его действия ; Сообщаем пользователю lea dx,Txtl


h0384.htm

384 Приложение

call Print ; 'Файл '

lea bx,NameFE

add bx,LName

add bx,3 ;BX - смещение нуля в конце имени

mov Mem,bx ;Сохраняем в Mem

mov ah,24h ,-Помещаем '$' в конец имени

mov [bx],ah

lea dx,NameFE

call Print ; Выводим имя файла

mov bx,Mem ;Восстанавливаем

mov ah,0 ;ноль в конце имени

mov [bx] ,ah

lea dx,Txt2

call Print ; ' заражен вирусом!' ; Проверяем расположение вируса

mov ax,Word ptr [Buffer+l6h]

cmp ax,Word ptr [Head+16h]

ja Delete /Вирус в конце файла

; Вирус в начале файла. Сообщаем и завершаем работу

lea dx,Txt21

call Print

mov ah, 1

int 21h ;Ждем реакцию пользователя

lea dx,TxtO

call Print ;EOL

jmp Exit ;3ааершаем работу

; Вирус в конце файла DELETE:

lea dx,Txt22

call Print ;Спрашиваем пользователя ; Вводим ответ пользователя

mov ah,1

int 21h

push ax

lea dx,TxtO

call Print ; EOL

pop ax

cmp al,'N'

je ExitP ;Выходим, если ответ 'N'

cmp al, 'n' ; Сравниваем с 'п'

EXITP: ret

Print PROC NEAR

; Выводим на экран текстовую строку ; При входе DX - смещение строки mov ah, 9

int 21h ret

NewFile PROC NEAR

; Подготавливаем имена $V$ и VIR-файлов ; и создаем $У$-файл

В процедуре NewFile подготавливаются имена файлов с расширениями $V$ и VJR: в файл с расширением $V$ помещается восстановленная копия файла, расширение VIR писваивается зараженной копии.

lea di,NameF$

lea bx,ext$

call CopyName -Имя $У$-файла

lea di,NameFV


h0385.htm

lea bx,Vir

call CopyName ;Р1мя VIR-файла ; Создаем $У$-файл

mov ah,3Ch

mov al,l

lea dx,NameF$

int 21h

jnc я1

jmp Error ml: mov HandVir,ax ;0писатель незараженного файла

ret

CopyName PROC NEAR ;Копируем строку имени файла с нужным расширением ; При входе DI - смещение приемника, ; ВХ - смещение расширения

mov es,cs0

lea si,NameFE

mov ex,LName

eld rep movsb ;Копируем до расширения

mov si,bx \

mov ex,4 rep movsb ;Копируем расширение

ret

WriteHead PROC NEAR

; Записываем в $У$-файл эталонный заголовок

С помощью процедуры WriteHead в $У$—файл записываются 24 байта эталонного заголовка из переменной Head. Процедура CopyFile копирует в него остальные Leng24 байта из исходного файла. Для убыстрения копирования процедура пытается выделить буферную память максимально возможного размера 64 Кбайт за концом программы. Если в конце программы нет свободной памяти, процедура пытается зарезервировать память вне программы с помощью обращения к функции ДОС $48, а если ДОС отвечает отказом, использует в качестве буфера незанятую часть стека. В подавляющем большинстве случаев программа после загрузки получает в свое распоряжение всю незанятую память, поэтому обращение к ДОС или использование стека осуществляется крайне редко.

mov ah,40h

mov cx,24 ;Длина заголовка 24 байт lea dx,Head mov bx,HandVi r int 21h jnc m2 jmp Error m2: ret

CopyFile PROC NEAR ; Определяем длину буфера ;и копируем незараженную часть ; Находим длину буфера

mov ax,SPO ;Вершина стека (в стеке АХ!)

cmp ax,OFFDOh ;Стек 64 Кбайт?

ja LargStack ;-да

add ax,17 ;Округляем с избытком

mov cl,4

shr ax,cl ;Переводим в параграфы

jmp GetSize LargStack:


h0386.htm

386________________________________________ Приложение

aov ax,1000h 64 К » 4096 параграфов GetSize:

ШОУ ex, as

add ax,ex AX - сегмент буфера

mov es,PSP Сегмент PSP

mov bx,es:[2] Получаем вершину памяти

sub bx,ax BX - доступная память в параграфах

crop bx,1000h Больше 64 Кбайт?

ja LargMem -Да

mov cl,4

shi bx,cl BX - доступная память в байтах

jmp m5 LargMem:

mov bx,OFFFFh Длина буфера -=64 Кбайт той: сюр bx,0 Есть свободная память?

jne SetMem -Да ; Нет свободной памяти - резервируем ее

mov ah,48h

mov bx,1000h

int 21h ;Резервируем 64 К

jnc OKay .-Удачно

cmp bx,0 ;Есть хоть сколько-нибудь памяти?

jne GetLowMem ;-Да ; Выделяем часть стека GetStack:

mov ax, ss

mov bx,sp

add bx,-2

jmp SetMem GetLowMem:

mov ah,48h ;Просим у ДОС блок памяти

int 21h ;длиной BX параграфов

jc GetStack ;He получаем - используем стек Okay:

piov MemF,bx ; Размер зарезервированной mov cl,4 ;памяти в параграфах shi Ьх,с1 ;Переводим в байты SetMem:

mov Mem,bx ;Запоминаем в MEM длину буфера

TOOV MemS,ax ;и в MemS сегмент

; Копируем незараженную часть файла

Copy:

mov ax,Leng2 AX - старшая часть остатка

mov сх,Меш СХ - максимальный буфер

cmp ах,0 Осталось больше длины буфера?

jnz Read -Да

cmp cx,Lengl Сравниваем с длиной буфера

jb Read -Буфер меньше остатка

mov cx,Lengl Копируем остаток целиком

; Читаем файл

Read:

mov ah,3Fh

mov dx,0 »Смещение буфера » О

mov bx,HandExa lЧитаем из зараженного файла

push ds ; Сохраняем DS

mov ds,HemS ;вуфер за концом программы

int 21h

pop ds


h0387.htm

jnc Write

jmp Error ;Если ошибка чтения ; Записываем файл Write:

mov ex,ax ;Число фактически прочитанных байт

mov ah,4 Oh

mov dx,0

mov bx,HandVir ;Пишем в $У$-файл

push ds

mov ds,MemS

int 21h

pop' ds

jnc m3

jmp Error ;Если ошиГха записи

; Изменяем длину остатка

m3: mov dx,Lengl ;DX - младшая часть длины

mov cx,Leng2 ;СХ - старшая часть длины

sub dx,ax ;AX - длина записанного

sbb cx,0 ;CX:DX - длина остатка

mov Leng2,cx

mov Lengl,dx

cmp ex,0

jnz Copy ; Повторяем

cmp dx, 0

jnz Copy ;пока остаток не станет нулевым

ret

Rename PROC NEAR

; Переименовываем ЕХЕ-файл в VIR-файл ;и $У$-файл в ЕХЕ-файл. Сообщаем о конце работы

После завершения копирования процедура Rename закрывает оба открытых файла и переименовывает их: исходный (зараженный) файл переименовывается в файл с расширением VIR, вновь созданный $У$—файл получает расширение ЕХЕ.

call CloseFiles ;Закрываем файлы mov ah,41h lea dx,NameFV

int 21h ;Удаляем VIR-файл mov ah,56h lea dx,NameFE push ds pop es lea di,NameFV

int 21h ;Переименовываем ЕХЕ в VIR jc Error mov ah,56h lea dx,NameF$ lea di,NameFE

int 21h ;Переименовываем $V$ в ЕХЕ jc Error ; Сообщаем о конце работы lea dx,Txt4

call Print ; 'Вирус удален...' lea dx,Txt20

call Print ; 'Нажмите...' mov ah,l

int 21h ;Ждем реакцию пользователя lea dx,TxtO call Print ret


h0388.htm

CloseFiles PROC NEAR ; Закрываем открытые файлы

mov bx,HandExe

cmp bx,0

3e Next

mov ah,3Eh

int 21h

30 Error

mov HandExe,0 Next:

mov bx,HandVir

cmp bx, 0

3e All

mov ah,3Eh

int 21h

30 Error

mov HandVir,0 All:ret

FreeMem PROC NEAR

; Возвращаем зарезервированную память

mov bx,MemF

cmp bx,0

30 Return

mov ah,49h

mov es,Mem3

int 21h

Return: ret

; Ошибка доступа к диску ERROR:

lea dx,Txt3 •" • ' ""

call Print ; 'Ошибка доступа к диску'

jmp Exit CSEG endS

end START

ПО. ПРОГРАММА ANTIVIR

Описание программы см. п.6.4.2.

П9.1. Текст программы AntiVir

{$Х+.Т-}

{

Программа контроля исполняемых файлов на возможность заражения компьютерным вирусом. При запуске командой ANTIVIR инициируется диалоговый режим, при запуске командой ANTIVIR /AUTO осуществляется автоматический контроль файлов, параметры которых хранятся в файле ANTIVIR.DAT.

}

Uses F Anti, {Включаем автоконтроль программы} CRT, DOS, F_Disk, Memory, StdDIg, MsgBox, HelpFile, {Этот модуль в исходном тексте входит в поставку TV и обычно

располагается в каталоге \bp\examples\idos\tvd.emos} Арр, Dialogs, Objects, Drivers,Views, Menus;

!

+-.--—--—---——-——-——---------————-—--+

1 Глобальные определения I


h0389.htm

+-——-----——-------—-———————-----+

/

type

(Описатель раздела ЖД) Part_Type а" record

BootF: Byte; (Флаг активности раздела}

BegHd: Byte; (Головка для начала раздела}

BegSC: Word; (сектор/цилиндр!

Sys : Byte; (Код системы}

EndHd: Byte; (Головка для конца раздела}

EndSC: Word; (сектор/цилиндр}

Sees : Longint; (Относительный номер начального сектора}

Size : Longint; (Длина раздела в секторах} end; (Part Type)

(Структура загрузочного сектора} BootSecType = record

a: array [0..$1BD] of Byte;

Part: array [1..4] of Part_Type;

b: array (1..2] of Byte end;

(Первый сектор файла} LType = record case Byte of 1: (Boot: BootSecType);

2: (W: array [1..256] of Word);

end;

(Описание логического диска в заголовке архивного файла} TLogicD - record

BHd: Byte; (Начальная головка}

BSC: Word; (Сектор-цилиндр)

Space: Longint; {Объем а секторах} end;

(Описание структуры ЖЯ в резервном файле} TStruc ~ record

BHd: Byte;

BSC: Word;

Sec: BootSecType end;

(Описание файла в архивной файле} CheckType = record

Name: PathStr; {Полное имя файла}

SecO: LType; (Эталон первого сектора}

SizO: Longint {Эталонная длина файла} end;

(Заголовок архивного файла} THead = record case Byte of 0:(

HD String [7]; ('ANTIVIR'}

BIOS Longint; (Контр.сумма BIOS}

Intl3 Pointer; {Адрес входа в Intl3}

NDisk Byte; {Количество ЛД}

SecTr Byte; {# секторов на дорожке!

Heads Byte; (Количество головок}

LDisk array [1..48] of TLogicD; (Ссылки на ЛД и их описатели}

Begl3 array [I..SizeOf(CheckType)-27-

48*SizeOf(TLogicD)] of Byte); {Начало Intl3) 1:(CT: CheckType) end;

{Turbo Vision программа, обеспечивающая диалог)


h0390.htm

PVir •^TVir;

TVir = object (TApplication)

HelpFile: String; (Пия Help-файла}

Procedure InitStatusLine; Virtual;

Procedure Run; Virtual;

Procedure DoHelp;

end;

var

F: File of CheckType; (Архивный файл} Head: THead; {Его заголовок} FColl: PCollection; (Архив в памяти}

BegDat: Longint; (Начало файловой области я архиве) сопзЪ

Stop : Boolean = True; (Признак отказа от контроля) IsVirus: Boolean = False; (Признак обнаруженного вируса) Files : Word •= 0; {Счетчик файлов} AntiV : PVir °- mii; (Указатель на диалог) FChange: Boolean = Fal&e; {Признак изменения коллекции)

{

+----—————————-——————-——————————+

¦ Типы, процедуры и функции, реализующие I I контроль загрузочных секторов и файлов 1 1 на возможное заражение вирусами 1 ] и лечение пораженных файлов (секторов) I

+———————————————————,—————————+

} Procedure Msg(S: String);

(Контролирует текущий видеорежш и susemv сообщение S с помощью Turbo Vision или оператором ftritstiii) var

R: TRect;

С: Char;

AOpt: Word;

begin

if AntiV=MXb then

begin (Обычный режим вывода) WriteLn(S) ;

Write(IНажмите любую клавишу...');

С :° ReadKey;

While KeyPressed do

С :° ReadKey end else

begin (Вывод в Turbo Vision) AOpt := mfOKButton;

AOpt :•= MessageBox(S, KIL,AOpt) end end; (Msg) {...- ————————— ;

Procedure WriteFile(Source: CheckType);

(Записывает в файл F очередную запись и контролирует ошибку) var

k: Integer;

begin

{$1-1

Write(F,Source);

($!+)

if IQResultoO then begin


h0391.htm

Тексты программ 3St

Msg('Ошибка записи в архивный файл');

Halt end end; {WriteFile} /-._——————————;

Procedure CheckErr(S: String);

{Проверяет статус диска, выводит сообщение S и останавливает счет, если

Dis^Error^True }

begin

if not Disk_Error then Exit;

Msg(S) ;

Halt

end; {CheckErr} /-^——————————/

Function Equal(var A,B; Size: Word): Boolean;

(Сравнивает Size байт из переменных А и В и возвращает TRUE, если они совпадают} var

Х: array [1..65535] of Byte absolute A;

Y: array [1..65535] of Byte absolute B;

Res: Boolean;

k : Word;

begin

k := 1;

repeat

Res :° X[k]=Y[k];

inc(k)

until not Res or (k>Size);

Equal := Res end; {Equal} {,...—————————}

Function Okay(s: String): Boolean;

{Дает сообщение S, возвращает TRUE,если нажата клавиша Y} var

с: Char;

begin {Okay}

Write(s+' (Y/N,Enter=Y)? ');

repeat

с := UpCase(ReadKey) ;

if KeyPressed then it ReadKey=' ' then;

case с of

#13: с := •Y';

'У :;

'N' :;

else Write(*7) end;

until (c-'Y') or (c°'N');

WriteLn(c) ;

Okay := c='Y' end; {Okay} ^_——————————/

Procedure ReStartDOS;

(Осуществляет перезапуск DOS! begin asm

mov ax,$FOOO (Сегмент перезапуска) push ax (Помещаем его в стек} mov ax,$FFFO {Смещение}


h0392.htm

push ax {Помещаем в стек) retf {Перезапуск ДОС} end end; {ReStartDos} {.-, ————_———_——}

const

Intl3Addr: Pointer=»NIL; {Адрес Intl3 в BIOS}

01d62: Pointer=NII.; (Старый вектор $62} /————.—————_——;

Procedure RWSecIntl3(Op,Hd,SC: Word; var Targ);

{Читает или записывает абсолютный сектор ВД с помощью непосредственного вызова Intl3 из BIOS} var

R: Registers;

begin

if Intl3AddrONIL then with R do begin

ah := Op;

al :- 1;

dh :- Hd;

dl := $80;

ex := SC;

es := Seg(Targ) ;

bx :"= Ofs (Targ);

Intr($62,R) ;

Disk Error := Flags and FCarryoO end else

GetAbsSector($80,Hd,SC,Targ) end; {R»SecIntl3} _•————————————;

Procedure Alarm;

/'Вызывается в случае обнаружения изменений в структуре ЖД} var

k: Integer;

Fl: File of TStruc;

c: CheckType;

Boot: BootSecType;

S,ss: String;

Procedure Save(H: Byte; SC: Word);

(Записывает абсолютные координаты сектора и сам сектор в файл Fl} var

LD: TStruc;

begin

if so'' then with LD do begin

BHD := H;

BSC := SC;

GetAbsSector($80,BHD,BSC,Sec) ;

Write(F1,LD) end end;

const

t: array [1..9] of String [80]=(

'Обнаружены изменения в структуре жесткого диска, которые могут быть",

'следствием заражения ПК вирусом!',

'Лечение загрузочного вируса основано на восстановлении структуры ЖД',

'в том виде, в каком она была к моменту создания архивного файла.',

'Эта операция может нанести непоправимый вред Вашему ПК, '+

"если архивный файл",


h0393.htm

'содержит ошибочную информацию (например, взят от другого ПК) ' +

'или не учитывает',

'новое разбиение жесткого диска на логические разделы.',

'Рекомендую перезагрузить DOS с эталонной дискеты и убедиться в том, '+

'что вирус',

'действительно существует (с помощью AIDSTEST, PCTOOLS и т.п.).');

begin

(Предупреждаем об опасности) for k := 1 to 9 do

begin

GotoXY((8O-Length(t[k])) div 2,WhereY);

WriteLn(t[k])

end;

Write(#7); (Звуковой сигнал} if Okay(*13#10'Перезагрузить DOS') then

ReStartDOS; (Перезагружаем ДОС} Write('Лечить (Y/N,Enter=N)? ');

if UpCase(ReadKey)<>'X' then

Halt;

{Запрашиваем дублирование на ГД и готовим файл с копиями зараженных секторов}

if Okay('Сохранить копию структуры ЖД на дискете') then repeat

Write('Вставьте дискету с открытой прорезью и введите имя ГД: ');

ReadLn(S) ;

s[l] := UpCase(s[l]);

if Length (s)=l then

s := s+':' until (s='A:') or (s='B:');

if so' 1 then begin

Assign(Fl,s+'\VIRDAT.$V$') ;

Rewrite(Fl);

end;

{Восстанавливаем структуру ЖД} Seek(F,l) ;

with Head do

for k := 1 to NDisk do with LDisk[k] do begin

Read(F,c);

Save(BHd,BSC) ;

RWSecIntl3(3,BHd,BSC,c.SecO) end;

if So1 ' then Close(Fl);

{Перезагружаем ДОС} ReStartDOS end; {Alarm} ^———————————;

Procedure CheckBoots;

{Проверяет структуру ЖД- Head уже содержит проверенный заголовок архивного

файла}

var

с: CheckType;

ch:"CheckType;

Buf: LType;

к: Word;


h0394.htm

begin {CheckBootsf

{Устанавливаем в вектор $62 BIOS-адрес входа в начало обработки прерывания

Intl3, чтобы обмануть utealth-вирусы}

GetIntVec($62,01d62); {Сй&саби век-гор $62} SetIntVec($62,Head.Intl3) ;

WriteLn;

WriteLn('Для досрочного завершения работы программы нажмите ESC")? WriteLn;

WriteLn('Антивирусный контроль описателей структуры ЖД:');

WriteLn('Головка','Сектор/цилиндр':20);

{Проверяем ссылки и описатели ЛД) with Head do

for k := 1 to NDisk do with LDisk[k] do begin

Write(BHD:4,BSC:17) ;

RWSecIntl3(2,BHd,BSC,Buf) ;

Read(F,c) ;

if Equal(c.SecO,Buf,512) then

WriteLn('Норма':20) else begin

WriteInCИзменен!'l20);

Alarm {Обнаружены изменения) end end;

{Нормальное завершение проверки} SetIntVec($62,01d62) ;

IntlSAddr := MIL;

BegDat :° FilePos(F) ;

{Наполняем коллекцию архивными файлами} WriteLn;

WriteLn('Читается архивный файл ANTIVIR.DAT...') ;

while not EOF(F) do begin

New(oh) ;

Read(F,ch^) ;

FColl".Insert(ch) ;

if KeyPressed and (ReadKey°#27) then

Halt end;

HriteLn

end; {CheckBoots} ^————————————/

Procedure SetFile(FName: String);

{Помещает в архив эталон файла FRAME} vac

ch: ^CheckType;

k, nz,sz: Word;

P : Pointer;

FP : file;

begin {SetFile}

Assign(FF,FName) ;

{$!-}

Reset (FF,1) ;

{?I+t

if lOResult <> 0 then MsgC Ошибка доступа к файлу Ч-FName)

else begin

{Искать в архиве одноименный файл:}


h0395.htm

Тексты программ___ ____ ____ ______________ 395

if FColl'-.CuuntOO then begin k := 0;

repeat

ch := FColl^Atfk) ;

inc (It);

until (ch".Name°=FName) or ()<=FColl^. Count) ;

if eh".Name=FName then

Exit end;

{Подготовить очередную запись:} New(ch) ;

ch'^.Name := FName;

ch^.SizO := FileSize(FF);

sz :° 512; (Длина блока чтения} if c^.Siz0^512 then

sz := ch^-SizO; {Файл меньше 512 байт} FillCharfch^.SecO,512,0) ;

BlockReadfFFyCh^.SecO,S2,nz) ;

Close(FF) ;

if nzosz then

MsgC Ошибка чтения из файла '-(•ch^-NanIS) else if not LowMemory then begin

FColl".Insert(ch) ;

FChange := True end else

k := MessageBox('Исчерпана доступная память', NIL,0) end end; {SetFile} ^-_——__—_——-_——;

Procedure BuildArch;

{Создает архивный файл} var

k,S13,013,h,s: Word;

c: CheckType;

ch^CheckType;

Din: TDisk;

begin

Rewrite(F);

if lOResuit <> 0 then begin

WriteLn('Невозможно открыть/создать файл данных );

Halt end;

{Создаем заголовок файла) with Head do begin

Hd := 'ANTIVIR';

{Подсчитываем КС BIOS} BIOS := 0;

for k := 0 to $FFFF do

BIOS := BIOS+Mem[$FOOO:k] ;

{Определяем вход в Intl3} asm

aov ah,$13

Int $2F

push ds (Сегмент)

push dx {Смещение)


h0396.htm

396 Приложение

Int $2F (Восстанавливаем Intl3f pop bx {Смещение} pop ax {Сегмент} mov S13,ax mov 013,bx end;

Intl3 := Ptr(S13,013) ;

Move(Intl3",Begl3,SizeOf(Begl3)) ;

NDisk := 0; (Количество дисков} end; fwitA Head} {Сканируем структуру ЖД} GetMasterBoot(c.SecO) ;

if not Disk_Error then with Head,c,SecO.Boot do

begin {Есть хотя бы один ЖД} h := 0;

s := 1;

Seek(F,l);

GetDiskInfo(2,DIn) ;

SecTr := DIn.TrackSiz;

Heads := Din.Heads;

{Цикл по всем ЛД: h,s - адрес ссылки}

repeat

/Запоминаем адрес ссылки в заголовке} inc(NDisk);

with LDisk[NDisk] do begin

BHd :° h;

BSC :- s;

Space :•• 1 end;

{Читаем ссылку на очередной ЛД}

GetAbsSector($80,h,s,c.SecO.Boot) ;

{Сохраняем ее в архиве} Name := 11 ;

SizO := 0;

Write(F,с) ;

{Ищем непустой описатель ЛД1 k := 1;

while (Part[k].BegSC»0) and (k<4) do inc(k) ;

if Part[k].BegSCOO then with Part[k] do begin

{Запоминаем адрес описателя в Head} inc (NDisk) ;

with LDisk[NDisk] do begin

BHd :- BegHd;

BSC :° BegSC;

Space :^s Size end;

{Запоминаем ссылку на следующий ЛД} inc(k);

h := Part [It] .BegHd;

s :° Part[k].BegSC;

{Запоминаем описатель в архиве} Name :« '';

SizO := 0;

with LDisk[Ndisk] do GetAbsSector($80,BegHd,BegSC,SecO);


h0397.htm

Write(F,с) ;

end (если непустой описатель) until S»0

end; {есть хотя бы один ЛД} {Записываем заголовок архива} BegDat ;= FilePos(F) ;

Seek(F,0) ;

Write(F,Head.CT) ;

Seek(F,BegDat);

(Защищаем COMMAND.СОМ} SetFile(GetEnv('COM3 PEC'));

end; (BuildHead} ^————————————;

Function CheckHead: Boolean;

(Проверяет заголовок архивного файла} var

s: String;

k: Word;

Sum: LongInt;

DI: TDisk;

begin

{Подсчитываем КС BIOS}

Sum := 0;

for k := 0 to $FFFF do Sum := Sum+Mem[$FOOO:k] ;

{Получаем конструктивные параметры ЖД}

GetDiskInfo(2,DI) ;

(Читаем заголовок архива}

Read(F,Head.CT) ;

(Проверяем его}

S := •ANTIVIR';

with Head do

if (Hdos) or (SumOBIOS) or

not Equal(Begl3,IntlJ^,SizeOf(Begl3)) or (SecTrODl.TrackSiz) or (HeaasODI. Heads) then begin

WriteLn('Архивный файл содержит ошибочные данные!');

if not Okay('Создать новый архив') then

Halt else

CheckHead := False end else

CheckHead :» True end; {CheckHead} ^————————————;

Function Auto: Boolean;

{Контролирует параметры обращения, открывает или создает DAT-файл. Возвращает

TRUE, если обнаружен ключ /AUTO}

var

s: String;

к,j: Byte;

AF: Boolean; Флаг ключа /АОТО}

с: CheckType absolute Head;

313,013: Word;

DI: TDisK;

labe.i.

SetF,Errria;

const

tx='Архивный файл содержит ошиоо-чные данные. Создать новый файл ;


h0398.htm

begin {Auto} AF := False;

for k •.sc 1 to ParamCount do begin

s := ParamStr(k);

for j := 1 to Length(s) do s[jl := OpCase(s[j]);

if s = '/AUTO' then

AF := True end;

fs = полное имя DAT-файла:} s := copy(ParamStr(0),l,pos('.',ParamStr(O)))+'DAT';

fГотовим коллекцию имен файлов} FColl := New(PCollection, Init(lOt), 10)) ;

{Формируем список дисковых описателей} GetListDisk(Disks) ;

Assign(F,s) ;

^1-;

Reset(F); {Проверяем существование архива} {$!+} if (IOResult<>0) or

not CheckHead then

BuildArch (Создаем, если нет архива) else (Файл существует}

CheckBoots; (Проверяем структуру ЖД} Auto := AF end; {Auto} /————————————;

Procedure Dialog;

{Осуществляет диалог с пользователем. Возвращает STOP=TRUE, если пользователь отказался от контроля. Использует средства библиотеки Turbo Vision} begin

New(AntiV) ;

with AntiV" do begin Init;

HelpFile := copy(ParaaStr(0),X,pos('.',ParamStr(0)))+'HLP';

RegisterHelpFile;

Run;

Done end;

Dispose(AntiV) end; {Dialog} ^————————————;

Procedure Check;

{Осуществляет контроль файлов по эталонам, хранящимся в коллекции FColl} var

FF: Pile;

Function Cure(SecO,Sec: LType): Byte;

{Проверяет тип файла и расположение в нем вируса и возвращает:

О - вирус в начале ЕХЕ-/Ьайла (не удаляется)

1 - вирус в конце ЕХЕ или СОМ-файяа

2 - вирус в начале СОМ-фаЯла

3 - пользователь не разрешил удалять вирус} var

С: Byte;

Eq: Boolean;

begin

with SecO do


h0399.htm

Тексты программ __ 399

if W[1]=$5A4D then {Если ЕХЕ-файл, проверяем сегмент точки запуска} if W[12]>=Sec.W[12] then

С := О {В начале или середине файла} else

С := 1 {В конце файла} else

(Если СОМ-файл, проверяем вторую половину сектора:} begin

if Equal(W[128],Sec.W[128],256) then

С := 1 (Нет изменений - вирус в конце} else

С := 2 {Сектор изменен - в начале} end;

if C=0 then

WriteLn('Вирус нельзя удалить, т.к.',

' он расположен в начале ЕХЕ-файла!') else

if not Okay('Удалять вирус') then С :° 3;

Cure :=> С end; {Cure} {—————} Procedure ReWriteFile(SizO: Longint);

{Перезаписывает незараженную часть СОМ-файла на место вируса максимально возможными блоками} vac

Sour,Dest,FSize: Longint;

Size: Word;

P: Pointer;

begin

Reset (FF,1) ;

Seek(FF,0);

FSize := FileSize(FF);

Sour := FSize-SizO; {Длина вируса} Dest :•= 0; {Начало файла} repeat (Переписать незаряженную часть

в -начало файла (на место вируса)} Size := 65520;

if FSize < Size then Size := FSize;

if Size > MaxAvail then Size := MaxAvail;

GetMem(P,Size) ;

Seek(FF,Sour); (Пропускаем вирус} BlocltReadtFF^^Size); (Читаем остальное} Seek(FF,Dest) ;

BlockWrite(FF,P",Size) ;

Sour :=• Sour+Size;

Dest := Dest+Size;

FSize := ^Size-Size;

FreeMem(P,Size) until FSize=0;

Truncate(FF); (Отсекаем лишнюю часть} Close(FF) ;

Reset (FF,1) end; {ReWriteFile} {—————} vax

oh : ^CheckType;

Sec : Lrype;


h0400.htm

k,nz,sz: Word;

label

VirDet,SetBeg,Next,Stop;

const

txl = 'Антивирусный контроль файлов (ESC - стоп):';

tx2 = 'Вирус не обнаружен.';

tx3 •= "Проверьте незащищенные файлы!';

tx4 = 'Вирус может быть резидентным,'+

' рекомендую перезагрузить систему!';

tx5 = 'Перезагрузить ДОС';

begin {Check}

if FColT'.Count^O then

Exit; {Нет файлов в коллекции} IntlSAddr :° Head.Intl3;

SetIntVec($62,Head.Intl3) ;

WriteLnC ': (80-Length(txl)) div2,txl);

Files := 0; {Счетчик проверенных файлов} for k := 0 to predtFColl".Count) do begin

oh := FCoU^Attk);

with ch" do begin Assign(FF,Name);

{$!-} Reset (FF,1) ;

l?I+} if lOResult о 0 then

WriteLnC Ошибка доступа к файлу ',Naine) else begin

{Сообщаем о контроле очередного файла} GotoXY(l,WhereY) ;

Write(' ':79); {Стираем строку} GotoXY(lO,WhereY) ;

Write(Name,' '); {Выводи» имя файла} inc(Files); {Счетчик файлов} {Читаем первый сектор файла) sz :- 512;

if FileSize(FF)<512 then

sz :° FileSize(FF); (Длина чтения} BlockRead(FP,Sec,sz,hz) ,• if szonz then begin

WriteLn( 'Ошибка чтения из файла ',Name);

Close(FF) ;

goto Next end;

{Контролируем файл:} if not Equal(Sec,Sec0,sz) then

Goto VirDet; (Изменен - вирус!} Close(FF) ;

goto Next; {Если нет отличий} VirDet: (Обнаружен вирус:}

WriteLn('заражен!'#7);

IsVirus :° True;

(Спрашиваем разрешения и лечим, если это возможно}

case Cure(SecO,Sec) of

0: goto Next; (Вирус в начале ЕХЕ-файла не удалять}

1: (Вирус в конце файла}


h0401.htm

begin

(Восстанавливаем первый сектор} SetBeg: Seek(FF,O);

BlockWrite(FF,SecO,sz,nz) ;

{Восстанавливаем начальную длину} if sz=nz then begin

Seek(FF,SizO) ;

Truncate(FF); {Отсекаем вирус} Close(FF) end else begin

Close(FF) ;

HriteLn('Ошибка записи в файл ^сп^.Ыате) end end;

2: {Вирус в начале СОМ-файла} begin

{Перемещаем программу вверх} ReWriteFilefch^.SizO) ;

{И восстанавливаем ее начало} Goto SetBeg;

end;

3: begin (Пользователь запретил лечение} Close(FF) ;

goto Next end end {case Cure} end; {if not Disk_Error} Next: if KeyPressed and (ReadKey#27) than

Goto Stop end {with ch"} end; {for k:=0 to} Stop:

SetIntVec($62,01d62) ;

Intl3Addr := NIL;

{Сообщаем об итогах проверки} Write(#13'Проверено ',Files,' файлов. 'It-if not IsVirus then

WriteLn(tx2) else begin

WriteLn(tx3) ;

WriteLn(tx4) ;

if OKay(tx5) then

begin {Перезапускаем ДОС} Close(f); {Сохраняем архив} ReStartDOS end end;

WriteLn('(C) 1992 г. В.В.Фаронов':80) end; {Check}

{

+_-_---_____--_--—————————-—————----+

I Типы, константы и подпрограммы для \ 1 реализации диалога средствами Turbo Vision I

+---_--______--_-_-_-_-_-—___———---------—-+

;


h0402.htm

const {Команды для диалога}

cmQui ~ 199 {Выход} cmSet = 200 {Поместить новый} cmDel ° 201 {Удалить существующий} cmRun =203 {Выполнить проверку} cmFresh=2O4 /Обновить информацию) cmAll = 205 {Выбрать все} стСО = 206 {Сменить каталог} cmCDW -= 207 {Сменить маску выбора файлов} стЕХЕ » 208 {Сменять СОМ на ЕХЕ и наоборот} type

{Основное диалоговое окно} PDWT="DWT;

DWT - object (TDialog)

Procedure HandleEvent(var Event: TEvent); Virtual;

Procedure AddFiles;

Procedure DelFiles;

Procedure FreshFiles;

end;

{Скроллер списка файлов} PFileListBox = "TFileListBox;

TFileListBox = object (TListBox)

PFL: PStringCollection; {Коллекция имен}

MarkL: Byte; {Длина маркера}

Procedure HandleEvent(var Event: TEvent); Virtual;

Procedure GetDir(WC: String);

Procedure MarkF(var s: String);

Procedure DemarkF(var s: String) ;

Procediire SetAll;

end;

{Строка ввода имени/маски файла} PInpLine » "TInpLine;

TInpLine •= object (TInputLine)

Procedure HandleEvent(var Event: TEvent); Virtual;

end;

{Окно режима добавления файлов}

PAddFileBox = "TAddFileBox;

TAddFileBox « object (TDialog)

WildC: String; {Маска} PL : PFileListBox; {Скроллер списка} PInL : PInpLine; {Строка ввода маски} PDir : PStaticText; {Имя каталога] Procedure HandleEvent(var Event: TEvent); Virtual;

Procedure SetFiles;

end;

{Окно режима удаления файлов}

PDelFileBox ""TDelFileBox;

TDelFileBox = object (TDialog

PL: PFileListBox; {Скроллер списка} Procedure HandleEvent(var Event: TEvent); Virtual;

end;

{Окно справочной служОы PMyHelpWindow =ATMyHelpWinc:ow;

TMyHelpWindow = object (THelpWindow)


h0403.htm

Тексты программ_________________ _____ 403

procedure HandleEvent(var Event: TEvent); Virtual;

Function GetPalette: PPalette; Virtual;

end;

^———————.———————————__—._——._.___+

I Создаем строку статуса и I I основное диалоговое окно I +————______——.——_—_____-_-_____________-+;

Procedure TVir.InitStatusLine;

{Формирует строку статуса.} var

R: TRect;

begin

GetExtent(R) ;

R.A.Y := pred(R.B.Y); {R - координаты строки статуса! StatusLine :» New(PStatusLine, Init(R, NewStatusDef(0,$FFFF,

NewStatusKey('~ESC~ Выход в ДОС = Стоп',kbFlO,cmQuit, NewStatusKeyl' ~F1~ Справочная служба',

kbFl,c'mHelp, NIL», NIL) ) ) ;

end; {TVir.InitStatusLine} ;-. —————____——-;

Procedure TVir.Run;

{Создает и использует основное диалоговое окно} var

DH; PDWT;

R : TRect;

Cntrl: Word;

const

cl « 'Программа защиты исполняемых файлов';

с2 = '(С) 1992, В.В.Фаронов';

сп = -5; {Левая граница ряда кнопок} begin

Stop := True;

{Создаем окно с поясняющими надписями}

R.Assign(5,5,75,14);

DW := New(PDwt, , Init (R, " )) ;

R.Assign(1,1,69,4) ;

DW.Insert(New(PStaticText,Init(R,#13#3+cl+#13+#3+c2))) ;

{Вставляем кнопки}

R.Assign(cn+7,6,cn+18,8) ;

EW-. Insert (New (PButton, Init (R, 1 •'S~ Стоп ', cmCancel,bfNormai))) ;

R.Assign(cn+18,6,cn+31,8) ;

DW.Insert(New(PButton,Init(R,1~A~ Добавить',cmSet,bfDefault))) ;

R.Assign(cn+31,6,cn+44,8) ;

DH".Insert(New(PButton,Init(R,'~D~ Удалить ',cmDel,bfNormal)));

R.Assign(cn+44,6,cn+58, 8) ;

DW^.Insert(New(PButton,Init(R,'~F~ ОбновитьI,cmFresh,bfNormal) ) ) ;

R«. Assign(cn+58,6,cn+72,8) ;

DW.Insert(New(PButton,Init(R,'~R~ Контроль',cmRun,bfNormal))) ;

DW^.HelpCtx := 1;

Cntrl :=• Desktop^.ExecView(DW);

end; {TVir.Run} {—— ——————._———;

Function TMyHelpWindow.GetPalette;

{Готовит нужную палитру для справки} coast

Р = #16#17#18»19»20#47#21#13;

С: String [81 = Р;


h0404.htm

begin

GetPalette := 8C end;

/——_—————_———;

Procedure TMyHelpWindow.HandleEvent;

{Обрабатывает клавишу F5 для выдачи команды cmZoom (распахнуть окно)} begin

THelpWindow.HandleEvent(Event) ;

if Event.What=evKeyboard then if Event.KeyCode=kbF5 then begin

Message(@Self,evCommand,cmZoom,@Self) ;

ClearEvent(Event);

end end;

^————————————;

Procedure TVir.DoHelp;

{Осуществляет доступ к контекстно-зависимой справочной службе} •wax

С: Word;

HF: PHelpFile;

HS: PDosStream;

HW: PMyHelpWindow;

begin

{Открываем DOS-поток:} HS := New(PDosStream,Init(HelpFile, stOpenRead)) ;

{Создаем и инициируем экземпляр объекта THelpFile:} HF := New(PHelpFile, Init(HS)};

if HS^-Status-stOk then

begin

/Создаем окно справочной службы и связываем его с потоком HS и текущим контекстом: }

HW := New(PMyHeipWindow,Init(HF, GetHelpCtx)) ;

if ValidView(HW) <> NIL then begin

С :° ExecView(HW); (Выдаем справку} Dispose(HW) {Удаляем окно} end end exse begin

Dispose(HF, Done);

if MessageBox('Нет доступа к файлу '+

HelpFile, NIL,mfError+mfOKButton)=0 then;

end end; [DoHelp} ^————————.——.——;

Procedure DWT.HandleEvent(var Event: TEvent) ;

{Обработчик событий основного окна. Реализует нестандартные команды, а также обрабатывает клавиши Left и Right для смены активности кнопок} begin {DWT.HandleEvent}

TDialog.HandleEvent(Event) ;

case Event.What of

evCommand: {Обработка нестандартных команд} begin

case Event.Command of cmHelp: AntiV".DoHelp;

cmSet: AddFiles;

cmDel: DelFiles;


h0405.htm

cmRun: begin

Stop := False;

TDialog.Done;

Event.Command := cmCancel;

Exit end;

cmFresh: FreshFiles;

else

Exit end;

ClearEvent(Event) end;

evKeyboard: (Клавиши Left-Right! begin

case Event.KeyCode of

kbLeft: SelectNext(True);

kbRight: SelectNext(False) ;

end;

ClearEvent(Event) end;

end end; {DWT.HandleEvent}

{

+————-——————————————-—+

I Обработка команды "Добавить файл" I

+--—------------_————---———————+

/ Procedure DWT.AddFiles;

{Обеспечивает выбор файлов из списка и помещает выбранные файлы в архив} vac

R,RR : TRect; {Координаты}

PathO: String; {Начальный каталог}

РН : PAddFileBox; {Окно выбора файлов}

ASB : PScrollBar; {Полоса скроллера}

Р : PView; (Вспомогательные элементы} const

с1 = 'Используйте клавиши курсора';

с11=- ' и Insert для выбора файла';

с2 = 'ESC - отказаться и выйти';

Wildcard: String" '*.*';

begin

GetDir(0,PathO); {PathO- каталог по умолчанию!

{Создаем диалоговое окно выбора файлов)

R.Assign(О,О,80,23) ;

PW := New (PAddFileBox, Init (R, "));

PW^.WildC := Wildcard;

{Вставляем поясняющий текст}

R.Assign(l,l,79,4);

W.Insert(New(PStaticText,Init(R,»3+cl+cll+#13#3+c2)) ) ;

R.Assign(l,4,79,5);

PW".PDir := New(PStaticText,Init(R,#3+'Каталог '+path0));

PH". Insert (PW.PDir) ;

{Вставляем строку выбора имени/маски}

R.Assign(25,7,52,8) ;

PW.PInL := New(PInpLine, Init(R,40));

with PW.PInL" do

State :- State or sfCursorVis;

PWЛ.PInLЛ.DataA :- Wildcard;

PW.Insert(PW.PInL);

R.Assign(25,6,52,"?) ••


h0406.htm

406__________________________________________________Приложение

Р :» New(PLabel,Init(R,'~M~ Маска файлов:',PW^.PInL));

РН^.Insert(Р) ;

R.Assign(52,7,54,8) ;

Р :-New(PHistory, Init(R,PHЛ.PInL,l)) ,• PW.Insert(P) ;

{Вставляем скроллер списка файлов} R.Assign(2,10,77,19);

RR.Assign(77,10,78,19);

ASB :- New(PScrollBar,Init(RR)) ;

PW.Insert(ASB) ;

New(PW^.PL,Init(R,4,ASB)) ;

PW.PL".GetDir(Wildcard) ;

PH".Insert(PW^.PL) ;

PW.PL^.MarkL := 15;

R.Assign(2,9,77,10) ;

P :- New(PLabel,Init(R,'~L~ Список файлов:',PW.PL));

PH".Insert(P) ;

{Вставляем кнопки! R.Assign (1,20,11,22) ;

PW^.Insert(New(PButton, Init(R,'~S~ Стоп',cmCancel,bfNormal))) ;

R.Assign (11,20,28,22) ;

PW.Insert(New(PButton, Init(R,'~A~ Выбрать все',cmAll,bfNormal)));

R.Assign (28,20,49,22) ;

PW.Insert(New(PButton, Init(R,'~D~ Сменить каталог',cmCD,bfNormal)));

R.Assign(49,20,63,22) ;

PW^.Insert(New(PButton, Init(R,'~R~ Добавить',cmRun,bfNormal))) ;

R.Assign(64,20,77,22) ;

PW.Insert(New(PButton, Init(R,'~E~ EXE/COM',cmEXE,bfMormal)));

PW^.HelpCtx := 2;

{Выполняем диалог)

DeskTop^.ExecView(PW)i

Dispose(PW,Done) ;

ChDir(pathO) /ВосстановДиваем текущий каталог} end {AddFlles}! ^————————————/

Procedure TAddFileBox.HandleEvent;

{Обработчик событий окна выбора файлов} vac

s: String;

PCD: PChDirDialog;

c: Word;

R: TRect;

p: Pointer;

label LI,All;

begin {TAddFileBox.HandleEvent] TDialog.HandleEvent(Event) ;

case Event.What of evCommand: case Event.Command of cmHelp: AntiV^.DoHelp;

cmExe: begin

if PInl^Data"-'*.СОМ' then

PInl^-Data^ :- '*.EXE else

Pin^-Data^ :° '*.COM';

PInl^.Draw;

goco LI end;

cmCDH: begin [Изменена маска выбора файлов)


h0407.htm

LI:

S :~ Pinl." .Data"; (Новая маска} PL^biSt :- NIL;

{Удаляем коллекции} Dispose(PLЛ.PFL, Done);

WildC :- S;

{Создаем новую коллекцию} PL^GetDirO) end;

cmCD: begin {Сменить каталог}

{Выбираем новый диск/каталог:} NewlPCD, Init(0,0));

с := DeskTop^.ExecView(PCD);

GetDir(0,s);

{s - имя нового каталога.Удаляем старое юля из окна} Dispose(PDir,Done);

R.Assign(1,4,79,5);

{Сообщить новое имя} PDir := New(PStaticText,Init(R,*3+'Каталог '+s));

Insert(PDir) ;

Goto LI;

end;

cmAll: begin {Выбрать все файлы) All: PL^SetAll;

PL".Draw end;

cmRun: SetFiles; {Добавить файлы в архив} end;

evKeyDown: case Event.KeyCode of kbLeft: SelectNext(True) ;

kbRight: SelectNext(False) ;

kbGrayPlus: Goto All;

end; {case Event.KeyCode} end; /case Event.What} ClearEvent(Event) end; {TAddFi 1 aBox. Hand-1 eEven t} ^————————————;

Procedure TAddFileBox.SetFiles ;

{Помещает в архив выбранные файлы.} var

S,ss: String;

k: Integer;

R: TRect;

p: PWindow;

PS: PString;

begin

{Сообщаем о добавлении файлов:} R.Assign(15,10,65,13) ;

P := New(PWindow,Init(R,'Добавляется файл:',0));

DeskTop".Insert(P) ;

{Выбираем из коллекции меченые файлы:} with PL^PFL" do for k := 0 to pred(count) do begin

s := GetText(k,255);

if s[Length(s)] = #251 then

begin (Выбран очередной меченый файл DemarkF(s); {Удаляем метку} System.GetDir(0,ss);


h0408.htm

408 Приложение

if ss[Length(ss)] <> '\' then ss :•= ss+'\';

ss := ss+s; {Добавляем маршрут поиска) {Сообщать имя} R.Assign(l,l,48,2) ;

Р".Insert(New(PStaticText,Init(R,#3+ss))) ;

SetFile(ss); {Помещаем файл в архив} PS := At(k) ;

PS^ := s end end;

Dispose(P,Done);

PL^.Draw

end; f'rAcW.i.IeBox.Setfi.IesJ I— —————-.-__——_

Procedure TInpLine.HandleEvent;

{Обработчик событий строки ввода имени или маски выбора файлов: выдает команду cmCDW, если изменен статус ввода) begin

TInputLine.HandleEvent(Event) ;

if (Event.What = evKeyDown) and (Event.KeyCode ° kbEnter) then

Message(Owner,evBroadcast,cmCDW,@Self) end; {TInpLine.HandleEvent) _————————..————;

Procedure TFileListBox.SetAll;

{Дополняет признаком выбора имена всех файлов) var

S: String;

k: Integer;

begin

with PFL" do for k := 0 to pred(Count) do begin

s :« GetText(k,255) ;

if s[Length(s)] <> #251 then

MarkF(s) else

DemarkF(s) ;

AtFree(k) ;

Insert (NewStr (s) ) end

and; {TFileListBox.SetAll} ^-———————————;

Procedure TFileListBox.GetDir(WC: String);

{Формирует коллекцию из имен файлов текущего каталога) var

SR: SearchRec;

AllExe: Boolean;

label

Rep;

begin

AllExe := HC='*.*';

if AllExe then WC := '*.com1;

PFL := New(PStringCollection, Init(10,5)) ;

Rep:

FindFirst(WC,$27,SR) ;

while DOSError a" 0 do begin


h0409.htm

Тексты программ 409

if (SR.Nameo'.') and (SR.NameO'. . ') then PFL".Insert(NewStrfSR.Name)) ;

FindNext(SR) end;

if AllExe then begin

AllExe := False;

WC := '*.EXE' ;

goto Rep end;

Self.NewList(PFL) end;

^————————————;

procedure TFileListBox.HandleEvent;

{Обработчик событий окна выбора файлов: использует клавишу Insert для пометки файла} var

S: String;

begin

TListBox.HandleEvent(Event);

if (Event.What = evKeyDown) then case Event.KeyCode of

Itblns: begin {Нажата клавиша Insert) ^ S := GetText(Focused,255); {Получаем выбор} PFL^.AtFree(Focused) ; {Удаляем файлиз коллекции} if S[Length(s)] =#251 then

DemarkF(s) {Убираем пометку} else

MarkF(s); {Добавляем пометку} PFL".Insert(NewStr(S)); {Вставляема колл} Event.KeyCode := kbDown; {Имитируем сдвиг} Draw; {указателя вниз} TListBox.HandleEvent(Event) ;

end;

koGrayPlus: {Серый "+" как "Выбрать все"]

Message(@Self,evCommand,cmAll,@Self) end

end; {TFileListBox.HandleEnent} ^____———_—————^

Procedure TFileListBox.MarkFfvar s: String);

{Помещает в строку S маркер выбора} begin

while Length(s)<MarkL do s : = s+' ';

s :" s+#251 end;

____———————.——;

Procedure TFileListBox.DeraarkF(var s: String);

{Удаляет маркер выбора из строки S} begin

while (s[Length(s)]=#251) or (s[Length(s)]=• •) do

System.Delete(s,Length(s),1) end;

{

+—_-----—-----------—----—-—----+

¦ Обработка команды "Удалить файл" \

+—————————————————————.——+

;

Procedure DelFile(ss: String);


h0410.htm

410 Приложение

{Удаляет файл с именем SS из архива) var

n : Integer;

ch: ^heckType;

begin

{Ищем нужный файл в архиве:}

n := 0;

repeat

ch := FColJ^.Attn) ;

inc(n)

until (ch''.Name=ss) ;

dec (n) ;

{Удаляем запись}

FCol:!^ .AtDelete (n);

FChange :v True end; {DelFile} _•————————————;

Procedure DWT.DelFiles;

{Удаляет файлы из архива} var

R: TRect;

PD: PDelFileBox;

ASB: PScrollBar;

k: Integer;

ch: '^CheckType;

const

cl = 'Используйте клавиши курсора';

ell- ' и Insert для выбора файла';

с2 = 'ESC - отказаться и выйти";

begin

(Формируем окно}

R.Assign(О,О,80,23);

PD := New(PDelFileBox, Init(R,''));

{Вставляем скроллер архивных файлов}

R.Assign(77,5,78,19);

ASB :-New(PScrollBar, Init<R»;

PD".Insert(ASB) ;

R.Assign(2,5,77,19);

PD^.PL := NewfPFileListBox, Init(R,2,ASB));

PD".Insert(PD^.PL) ;

PD^.PL^MarkL := 34;

R.Assignd, 1,79,3) ;

PD^.Insert(New(PStaticText,Init(R,#3+cl+cll+#13»3+c2))) ;

R.Assign(2,4,77,5) ;

VQ".Insert(New(PLabel, Init(R,'-L~ Список архивных файлов:',PD".PL)));

{Вставляем кнопки}

R.Assign(1,20,15,22);

PD". Insert (New (PButton, Init(R,'~S~ Стоп', cmCancel,bfNonn9l)));

R.Assign(16,20,35,22);

PD".Insert(New(PButton, Init(R,'~A~ Выбрать все',cmAll,bfHormal))) ;

R.Assign(36,20,50,22) ;

PD^.Insert(New(PButton, Init(R,'~R~ Удалить',cmRun,bfNormal)));

{Создаем коллекцию имен файлов } PD^.PL^PFL := New(PStringCollection,Ir»it(10,5) ) ;

for It := 0 to predtFColT^ Count) do with PDA.PL'^.PFLЛ do begin

ch := FColl*.At(k);

Insert(NewStr(ch*.Name))


h0411.htm

end;

PD^.PL".NewList(PD'.PL^.PFL) ;

PD^.HelpCtx := 3;

{Выполняем}

DeskTop".ExecView(PD) ;

Dispose(PD,Done) end; {DelFilesf /——————————————;

Procedure TDelFileBox.HandleEvent;

iОбработчик событий окна удаления файла(ов)} var

R: TRect;

k: Integer;

s: String;

p: PWindow;

begin

TDialog.HandleEvent(Event) ;

case Event.What of evConmiand: case Event. Command of cmHelp: AntiV'.DoHelp;

cmAll: begin

PL^SetAll;

PL*.Draw;

ClearEvent(Event) end;

cmRun:

begin

R.Assign(15,10,65,13) ;

P :- New(PWindow,Init(R,'Удаляется файл:',0));

DeskTop^.Insert(P);

with PL'-,PFLA do for k := 0 to pred(count) do begin

s := GetText(k,255);

if s[Length(s)] - #251 then

begin (Только для помеченных файлов} {Удаляем радикал и пробелы в имен^ while (s[Length(s)]=»251) or

(s[Length(s) ]"' ') do System.Delete(s,Length(s),1) ;

(Сообщаем имя удаляемого файла} R.Assign(1,1,48,2) ;

PA.Insert(New(PStaticText,Init(R,#3+s))) ;

DelFile(s) fУдаляем из архива} end end;

Dispose(P,Done);

EndModal(cmCancel) end {cmR.un} end; {case Event.Command} evKeyDown: case Event.KeyCode of kbLeft : SelectNext(True) ;

kbRight: SelectNext(False) end {case Event.KeyCode} end; {case Event.What} ClearEvent(Event) end; {TDelf'ileBox.HandleEvent}

{

^.__—-----———--—----——————---——-+


h0412.htm

412 Приложение

¦ Обработка команды "Обновить информацию" I

+_-----------------—---_-__------_-------+

/ Procedure DWT.FreshFiles;

{Обновляет информацию в архиве} var

disk: Byte;

k: Integer;

R: TRect,-p: PWindow;

ch: "CheckType;

DI: Dir_Type;

FF: file;

sz,nz: Word;

label NotAcc;

begin

R.Assign(15,10,65,13)? P := New(PWindow,Init(R,'Переустанавливается файл:',0));

DeskTop^.Insert(P);

k := 0;

while k<VColl^.Count do begin

ch := FColl^.Atfk);

with ch" do begin

R.Assign(l,l,48,2) ;

(Выводим имя файла! Р".Insert(New(PStaticText,Init(R,#3+Name))) ;

Assign(FF,Name);

{$!-} Reset (FF,1);

{$!+} if IQResult <> 0 then {Ошибка доступа - удаляем файл из архива)

begin NotAcc; if MessageBoxt

'Нет доступа к файлу '+Ыаше+#13'Убрать контроль за файлом?', NXL,

mfYesButton+mfNoButton)«cmYes then begin

FColl*.AtDelete(I<) ;

FChange := True end end

else {Нормальное открытие файла! begin

sz := 512;

if sz > FileSize(FF) than sz := FileSize(FF);

FillChar(SecO,512,0);

BlockRead(FF,SecO,sz,nz);

if sz=nz then begin

SizO :- FileSize(FF);

FChange := True end else (Файл не читается)

MessageBox('Ошибка доступа к файлу 4-Name, NIL,0);

System.Close(FF)


h0413.htm

end

end; {with chл} inc(k)

end; {while k<FColl".Count) Dispose(P,Done) end; {FreshFiles} I +-—•--------------------------+

I Основная программа AntiVir ¦ +----—----——----------------+

;

var

k: Word;

ch^CheclcType;

begin {AntiVirl

{Проверяем параметры обращения) if not Auto then

Dialog {Диалог с пользователем} else

Stop := False; {He было диалога} if not Stop then

Check; {Контролируем файлы} {Если коллекция изменялась, переписываем еев архивный файл} if FChanga then begin

Seek(F,BegDat) ;

for k := 0 to precKFCol^ .Count) do begin

ch := FColl^Attk) ;

Write(F,ch^) end;

Truncate(F) end;

Close (F) {Закрываем DAT-файл} end. {AntiVir}

П9.2. Программа восстановления структуры ЖД Set$v$.pas

Эта программа восстанавливает структуру ЖД (главный загрузчик и описатели разделов), предварительно спасенную программой AntiVir. t

Uses F Anti,F_Disk;

type

(Описатель раздела ЖД} Part_Type = record

BootF: Byte; {Флаг активности раздела}

BegHd: Byte; {Головка для начала раздела}

BegSC: Word; {сектор/цилиндр}

Sys : Byte; {Код системы}

EndHd: Byte; {Головка для конца раздела/

EndSC: Word; {сектор/цилиндр}

Sees : Longint; {Относительный номерначального сектора}

Size : Longint; {Длина раздела в секторах} end; {Part_Type}

{Структура загрузочного сектора} BootSecType = record

a: array [0..$1BD] of Byte;

Part: array [1..4] of Part_Type;

b: array [1..2] of Byte end;


h0414.htm

{Описание структуры ЖД в резервном файле} TStruc = record BHd: Byte;

BSC: Word;

Sec: BootSecType end;

const

tx: array [ 1..5] of String»(

'Эта программа предназначена для восстановления структуры жесткого диска, ',

'испорченной в результате работы программы ANTIVIR', 'и сохраненной в файле VIRDAT.$V$',

'Используйте вызов с указанием маршрута поиска файла VIRDAT.$V$, например' ,

' SET$V$ A:\') ;

var

Name: String;

F: File of TStruc;

LD: array [1..48] of TStruc;

k: Byte;

Err: Boolean;

Count: Byte;

begin

if ParamCountOl then begin

for k := 1 to 5 do WriteLn(tx[k]) ;

Halt end;

Name := ParamStr(l);

for k :•== 1 to Length (Name) do Namefk] := UpCase(Name[k]) ;

k := Pos('VIRDAT',Name);

if k<>0 then

Delete(Name,k,Length(Name)-k) ;

if Name[Length(Name)]о'\' then Name :=> Name+'\';

Name :" Name+'VIRDAT.$V$';

{$!-} Assign(F,Name) ;

Reset(F) ;

l$I+{ if IQResultOO then begin

WriteLn('Нельзя открыть файл ',Name);

Halt;

end;

Count := 0;

Err := False;

while -Ot (Err or EOF(F» do begin

inc(Count) ;

{$!-} Read(F,LD[Count]) ;

{$!+} Err := lOResultOO end;

Close(F) ;

if odd(k) or Err then


h0415.htm

begin

WriteLn('Ошибка в данных файла '+ Name);

Halt end;

for k := 1 to Count do with LD[k] do begin

SetAbsSector($8O,BHd,BSC,Sec) ;

if Disk_Error then begin

WriteLn('Ошибка записи на жесткий диск['If-Halt end end;

{Сообщаем об окончании} Write ('Структура ЖД восстановлена. Перезагружать ДОС (Y/N, Enter'«Y) ? ');

ReadLn(Name) ;

if (NameO'n') or (NameO'N') then asm

mov ax,$FOOO {Сегмент перезапуска) push ax {Помещаем его в стек} mov ax,$FFFO {Смещение} push ax {Помещаем в стек} retf {Перезапуск ДОС} end end.

П10. МОДУЛЬ F_PROT ДЛЯ ЗАЩИТЫ ПРОГРАММ ОТ НЕЛЕГАЛЬНОГО КОПИРОВАНИЯ

ШОЛ.. Программа Diskette для подготовки ключевой дискеты

Описание программы см. п.7.2.5.

/

+_-__----_-------------------—--—-------------+

¦ Форматирование дорожки нестандартными секто- ¦ ¦ рами с помощью прерывания $13. Используется ¦ ¦ дисковод 5 1/4 дюймов в режиме 360 Кбайт. ¦ ¦ Эта программа готовит дискету для работы \ ¦ с модулем F_Prot. \ +--__----------------.------_-------------------+;

Program Diskette-Uses DOS,F_disk;

const

TRK = 40; {Номер нестандартной дорожки} DSK =- 0; {Номер диска} SIZ = 1; {Код размера сектора} type

PDBT_Type ^DBTJType; {Указатель на ТПД1 {Таблица параметров дискеты} DBT_Type = record

Reservl array [0..2] of Byte;

SizeCode Byte; {Код размера сектора}

LastSect Byte; {Количество секторов на дорожке!

Reserv2 array [5..7] of Byte;

FillChar Char; {Символ-заполнитель форматирования} ReservS Word


h0416.htm

end;

{Элемент буфера форматирования} F_Buf = record

Track: Byte; {Номер дорожки)

Head : Byte; {Номер головки}

Sect : Byte; {Номер сектора}

Size : Byte {Код размера} end;

var

Old: PDBT_Type; {Указатель на исходную ТПД) /—-___————___——;

Procedure Intrl3(var R: registers; S: String);

[Обращается к прерыванию 13 и анализирует ошибку (CF=1 - признак ошибки). Если ошибка обнаружена, печатает строку S и завершает работу программы} begin

Intr($13,R) ;

if R. Flags and FCarryoO then

if R.ah о б then {Игнорируем ошибку от смены типа дискеты} begin

WriteLn(S) ;

SetIntVec($lE,01d); {Восстанавливаем старую ТПД} Halt end end; {Intrl3} ^_____-__————___;

Function AccessTime(DSK,TRK: Byte): Real;

{Измеряет время доступа к дорожке и возвращает его своим результатом (в секундах) } var

Е: array [1..9*512] of Byte;

t,k: Longint;

R: registers;

begin

t :- MemL[0:$046C] ;

while t=MemL[0:$046C] do;

for k :- 1 to 10 do with R do begin

ah :- 2;

al := 9;

ch := TRK;

cl :- 1;

dh := 0;

dl := DSK;

es :- seg (E) ;

bx := ofs(E) ;

Intrl3(R,'Error') end;

AccessTime :- (MemL[0:$O46C]-t-1)*0.055

end;

/——————————;

var

B: array [1..9] of F Buf; {Буфер для форматирования}

k,N: Integer; {Счетчик цикла}

R: registers; {Регистры}

DBT: PDBT_Type; {Указатель на новую ТПД}

С,О: array [1..1024] of Byte; {Буферы чтения/записи)

Size: Word; {Длина сектора}

Info: TDisk;

begin {Главная программа}


h0417.htm

418 _____ Приложение

ReadLn(C[200]);

C[17] := 0;

{Считаем контрольную сумму} М := 0;

for k := 2 to 255 do N := N+C[k];

C[256] := M mod 256;

{Шифруем сектор}

С[1] := Random(255)+1;

for k := 2 to 256 do C[k] :» C[k] xor C[1] ;

{Записываем сектор}

ah := $03; {Код операции записи)

а1 :-=• 1; {Записать 1 сектор}

ch :- TRK; {На дорожке TRK}

с1 := 1; {Начиная с сектора 1}

dh := 0; ^На поверхности 0}

dl := DSK; №ск DSK1

es := seg(C); {Адрес буфера С для записи}

Ьх :-. ofs(C) ;

Intrl3(R,'Ошибка записи');

{Читаем сектор)

ah := $02; ^Код операции чтения) а1 :=• 1;

ch := TRK;

с1 :- 1;

dh :- 0;

dl := DSK;

es := seg(D); {Адрес буфера D для чтения) Ьх :» ofs(D) ;

Intrl3(R,'Ошибка чтения') end;

{Проверяем совпадение) for k := I to Size do if c[k:]<>d[k] then begin

WriteLn('Несовпадение данных') ;

SetIntVec($lE,01d) ;

Halt end;

WriteLn('Создана и проверена ',TRK+1,

'-я дорожка с секторами по ',Size,' байт');

{Измеряем время доступа к новой дорожке)

Write('Время доступа к скрытой дорожке: ');

MriteLn(AccessTime(DSK,TRK):6:2,' с') ;

{Измеряем время доступа к стандартной дорожке)

DBTA.SizeCode := 2; {Указываем стандартную длину сектора в ТПД} Write('Доступ к обычной дорожке: ');

WriteLn(AccessTime(DSK,20):6:2,' с') ;

{Восстанавливаем старую ТПД}

SetIntVec($lE,01d) end.

П10.2. Модуль F_Prot

Описание модуля см. п.7.4.

^»=-«==»=====»=; unit F_Prot; {"»..-"=—==-="=»}

{

+--_----—---—-._------——-——---------—-——-,+


h0418.htm

Модуль используется для защиты программ от ¦ нелегального копирования. Мобильный вариант ¦ программы защищается с помощью ключевой ди- ¦ скеты, стационарный вариант - за счет кон- ) троля даты создания ПЗУ. I +—————————————————————————————+;

INTERFACE Procedure ProtCheck(var P1,P2; var Res: Integer);

{Проверяет легальность копии:

PI - адрес процедуры NORMA; P2 - адрес процедуры ALARM;

Res - результат работы:

0^: был вызов NORMA;

1: был вызов ALARM;

2: не вставлена дискета. Любое другое значение может быть только при трассировке программы}

Function SetOnHD: Integer;

(Устанавливает копию на жесткий диск. Возвращает:

-1 - не вставлена дискета;

-2 - не мастер-дискета;

-3 - защита от записи или ошибка записи;

-4 - программа не скопирована на ЖД;

-5 - ошибка доступа к ЖД;

-6 - исчерпан лимит установок;

-7 - программа уже установлена;

>—0 - количество оставшихся установок}

Function RemoveFromHD: Integer;

{Удаляет копию с жесткого диска. Возвращает:

-1 - не вставлена дискета;

-2 - не мастер-дискета;

-3 - защита от записи или ошибка записи ГД;

-4 - программа не скопирована на ЖД;

-5 - ошибка доступа к ЖД;

>=0 - количество оставшихся установок}

IMPLEMENTATION Uses DOS,F_Disk;

type

TDate = array [1..4] of Word;

TKey = record case Byte of

0: (

Hard: Word; (Ключ для шифровки данных} Dat : TDate); {Дата создания ПЗУ}

1:(KeyW: array [1..5] of Word);

end;

const

TRK = 40; (Номер дорожки}

HED =0; {Номер головки}

SEC =1; {Номер сектора}

SIZ = 1; {Код размера секторов}

ETracks - 40; /Эталонное количество дорожек на дискете!

ETrackSiz - 9; {Эталонное количество секторов на дорожке}

Кеу:ТКеу - (KeyW:(О,О,О,О,0)); {Ключ стационарной программы} ;•-——————————;

Procedure TrassBlockl;

{Макрос для борьбы с трассировкой с помощью модификации команды} inline ( {ВО:}

$ОЕ/ {push cs}


h0419.htm

$E8/$00/$00/ {call 61} {@1:}

$5В/ {pop bx}

$83/$ЕВ/$04/ {sub bx,@l-@0)

$07/ {pop es}

$53/ {push bx}

$B4/$C3/ {mov ah,$C3}

$26/$88/$67/$11/$90/ {mov es:[Ьх+в2-в0],ah} i@2:}

$90/ {пор}

$B4/$9O/ {mov ah, $90}

$26/$88/$б7/$11/$90/ {mov es:1Ьк+в2-@0],ah]

$5B); {pop by.) ^————.——————__^

Procedure TrassBlock2;

{Борьба с трассировкой с помощью контроля времени} vac

tl,t2: Longint;

label

Loop;

begin Loop:

tl := MemL[0:$046Cl ;

t2 := 0;

while MemL[O:$O46C]=tl do;

while MemL[0:$O46C]<tl+2 do inc(t2) ;

if t2<500 then goto Loop;

TrassBlockl end; {TrassBlock2} ^————————————;

type

TBuf = array [1..256] of Byte;

var

P: Pointer; {Ссылка на врежнюю ТПД} Buf: TBuf; {Буфер чтения/записи сектора} R: registers; {Регистры} _—.—— _——————_-;

Function DiskettPrepare(var DSK: Byte): Boolean;

type

DBT Type aE record {Структура таблицы параметров дискеты} Reservl : array [O..2] of Byte;

SizeCode: Byte; {Код размера сектора} LastSect: Byte; {Количество секторов на дорожке} Reserv2 : array [5..10] of Byte end;

var

Info: TDisk;

DBT,01dDBT:^DBT_Type;

begin {Проверяем наличие дискеты}

DSK := 0; {Начинаем с диска А:} repeat

TrassBlockl;

GetDiskInfo(DSK,Info) ;

if Disk Error then if DSK=0 then

DSK := 1 (Повторяем для диска В:} else


h0420.htm

Тексты программ 421

DSK := 2 (Закончить с ошибкой} until not Disk_Error or (DSK=2);

TrassBlock2;

if Disk_Error then

begin {Нет доступа ни к А:, ни к В:! DiskettPrepare := False;

Exit end;

(Проверяем тип дискеты} TrassBlockl;

with Info do begin

if (TracksOETracks) or

(TrackSizOETrackSiz) then begin {He эталонный тип) DiskettPrepare := False;

DSK := 3;

Exit end;

{Переустанавливаем ТПД} TrassBlockl;

GetIntVec($lE,P) ;

OldDBT := P;

New(DBT);

DBT^'OldDBT'1;

with DBT" do begin

SizeCode := SIZ;

LastSect := ETrackSiz end;

SetIntVec($lE,DBT) end;

DiskettPrepare := True end; {DiskettPrepare} /————————————;

Function LegalDiskett(var DSK: Byte): Boolean;

(Проверяет легальность мобильной копии} var

k,n: Word;

begin

(Подготавливаем дискету} if DisltettPrepare(DSK) then

begin

{Читаем ключевой сектор} TrassBlockl;

with R do begin

ah :=• 2;

al := 1;

ch :- TRK;

Cl := SEC;

dh := HED;

dl := DSK;

es := seg(Buf) ;

bx := ofs (Buf) ;

Intr($13,R) ;

SetIntVec($lE,P) ;

if (Flags and FCarry)<>0 then begin


h0421.htm

422 .Приложение

LegalDiskett :<" False;

DSK := 4;

Exit end else

begin {Проверяем содержимое сектора} for k := 2 to 256 do

Buf[k] := Buf[k] xor Buf[l];

N := 0;

l$R-f for k := 2 to 255 do N :- N+Buf[k] ;

if (N mod 256°Buf[256]) then begin

DSK :=• 0;

LegalDiskett :- True end else begin

DSK :- 4;

LegalDiskett := False end end end end else

LegalDiskett := False end; {LegalDiskett} ^————__-——————;

Function LegalHD(var DSK: Byte): Boolean;

{Проверяет легальность стационарной копии) var

k: Word;

Date :^TDate;

Legal: Boolean;

label

ExitL;

begin {Расшифровываем ключ!

TrassBlockl;

with Key do for k := 2 to 5 do KeyW[k] :- KeyW[k] xor KeyW[l];

{Проверяем дату изготовления ПЗУ)

TrassBlock2;

k := 1;

Date := ptr($FOOO,$FFF5);

repeat

Legal :-Date"[k]=Key.Dat[k] ;

inc(k)

until not Legal or (k=5) ;

LegalHD := Legal; ,

TrassBlockl;

{Проверяем дискету)

if Legal then DSK := 0

else

Legal :- LegalDiskett(DSK) ;

LegalHD := Legal end; {LegalHD} /————————————;


h0422.htm

Тексты программ 423

Procedure ProtCheck(var P1,P2; var Res: Integer);

{Проверяет легальность копии:

PI - адрес процедуры NORMA; P2 - адрес процедуры ALARM;

Res - результат работы:

0: был вызов NORMA;

1: был вызов ALARM;

2: не вставлена дискета.

Любое другое значение может быть только при трассировке программы}

type

РТуре = Procedure;

var

Norma: РТуре absolute Pl;

Alarm: РТуре absolute P2;

DSK : Byte;

label

L1,L2;

begin

Res :» -1;

TrassBlockl;

if Key.Hard=0 then

if LegalDiskett(DSK) then begin

TrassBlock2;

LI:

Norma;

Res := 0 end else

begin L2:

TrassBlock2;

if DSK=2 then

Res := 2 else begin Alarm;

Res := 1 end end else

if LegalHD(DSK) then

goto Ll else

goto L2 end; (ProtCheck} ^_-——————.————;

Procedure HidnSec(var Buf: TBuf; Inst,Limit: Byte);

{'Цифрует буфер ключевого сектора} var

k,n: Word;

begin

TrassBlockl;

Randomize;

for k := 2 to 254 do Buf[k] := Random (256);

Buf[l] := Random(255)+1; {Ключ для шифровки}

{$R-}

Buf[17] := Inst; {Счетчик установок} Buf[200] := Limit; {Лимит установок} n := 0; {Подсчет КС}


h0423.htm

for k := 2 to 255 do

n := n+Buf[k] ;

Buf[256] := n mod 256; {Контрольная сумма} {Шифруем все данные} for k := 2 to 256 do

Buf[k] := Buf[k] xor Buf[l];

{$R+f end; {HidnSec} ^————————.————^

Function SetOnHD: Integer;

(Устанавливает стационарную копию на жесткий диск. Возвращает:

-1 - не вставлена дискета;

-2 - не мастер-дискета;

-3 - защита от записи или ошибка записи ГД;

-4 - программа не скопирована на ЖД;

-5 - ошибка доступа к ЖД;

-6 - исчерпан лимит установок;

-7 - программа уже установлена.

>=0 - количество оставшихся установок}

var

DSK: Byte; . '.Диск} F: file; {Файл с программой} Date^TDate; {Дата ПЗУ) NameF: String; {Имя файла с программой} W: array [1..5] of Word; {Заголовок файла} n: Word; {Счетчик} L: Longint; {Файловое смещение} Inst: Byte; {Количество установок} label ErrWrt;

begin

TrassBlockl;

if Key.HardoO then begin

SetOnHD :=-7;

Exit end;

{Проверяем резидентность программы) NameF := FExpand(ParamStr(0)) ;

if NameF[1] in ['A','B'] then begin

SetOnHD := -4;

Exit end;

(Проверяем дискету}

if not LegalDiskett(DSK) then begin

case DSK of 2: SetOnHD := -1;

else

SetOnHD := -2;

end;

Exit end;

if (Buf[200]<>255) and (Buf[17]>=Buf[200]) then

begin {Исчерпан лимит установок} SetOnHD := -6;

Exit end;


h0424.htm

(Запоминаем дату изготовления ПЗУ} TrassBlockl;

Date := ptr($FOOO,$FFF5) ;

Key.Dat := Date^;

{Шифруем параметры} Randomize;

with Key do

while Hard=0 do Hard := Random($FFFF);

for n := 2 to 5 do with Key do KeyW[n] := KeyW[n] xor Hard;

{Открываем файл с программой} TrassBlockl;

Assign(F,MameF) ;

Reset(F,1) ;

{Читаем заголовок файла} BlockRead(F,W,SizeOf(W) ,n) ;

if noSizeOf(W) then begin

SetOnHD := -5;

Exit end;

{Ищем в файле положение Hard} R.ah := $62;

MSDOS(R) ;

P := @Key;

L :- round;(DSeg-R.bx-16+W[5])*16.0)+ofs(P") ;

Seek(F,L) ;

{Записываем в файл} TrassBlockl;

BlockWrite(F,Key,SizeOf(Key),n) ;

if noSizeOf(Key) then begin

SetOnHD :» -5;

Close(F) ;

Exit end;

(Шифруем ключевой сектор} Inst :=Buf[200]-Buf[17]-l;

HidnSec(Buf,Buf[17]+l,Buf[20O]) ;

(Записываем на дискету новый ключ} TrassBlockl;

if not DiskettPrepare(DSK) then

begin {Ошибка доступа к дискете: удаляем установку} ErrWrt:

FillChar(Key,SizeOf(Key),0) ;

See)<:(F,L);

BlockWrite(F,Key,SizeOf(Key),n) ;

SetOnHD :=-3;

Close(F) ;

Exit end;

with R do begin

an =• 3 ;

al = 1;

ch = TRK;

cl = SEC;

dh - HED;

dl = DSK;

es = seg (Buf) ;


h0425.htm

bx := ofs (Buf) ;

Intr($13,R) ;

if (Flags and FCarry)<>0 then

goto ErrWrt end;

{Нормальное завершение} SetOnHD := Inst;

SetIntVec($lE,P) ;

Close(F) end; {SetOnHD} ^———————__——;

Function RemoveFromHD: Integer; ' (Удаляет стационарную копию. Возвращает:

-1 - не вставлена дискета;

-2 - не мастер-дискета;

-3 - защита от записи или ошибка записи ГД;

-4 - программа не скопирована на ЖД;

-5 - ошибка доступа к ЖД;

>=0 - количество оставшихся установок} var

k,n: Integer;

NameF: String;

В: array [1..512] of Byte;

F: file;

DSK,Inst: Byte;

begin

TrassBlockl;

if Key.Hard=0 then begin

RemoveFromHD := -4;

Exit end;

if not LegalDiskett(DSK) then begin

if DSK=2 then

RemoveFromHD := -1 else RemoveFromHD := -2;

Exit end;

{Стираем файл с программой на ЖД} NameF := FExpand(ParamStr(0); ;

if NameF[1] in ['А'..'В'] then begin

RemoveFromHD := -4;

Exit end;

Assign(F,NameF);

Ifl-t Reset(F,I» ;

{$!+} if IOResult<>0 then begin

RemoveFromHD :" -5;

Exit end;

{Уничтожаем заголовок файла} FillChar(B,512,0) ;

BlcckWrite(F,B,51z,n) ;


h0426.htm

if п<>512 then begin

RemoveFromHD :•= -5;

Exit end;

Close(F) ;

Erase(F); {Стереть файл! {Шифруем ключевой сектор} Inst := Buf[200]-Buf[17]+l;

HidnSec(Buf,Buf[17]-l,Buf[2OO] ) ;

{Записываем на дискету новый ключ) TrassBlockl;

if not DiskettPrepare(DSK) then begin

RertioveFromHD :~ -1;

Exit end;

with R do begin

ah = 3;

al = 1;

ch = TRK;

cl = SEC;

dh = HED;

dl = DSK;

es = seg(Buf) ;

bx = ofs (Buf) ;

Intr($13,R);

if (Flags and FCarry)<>0 then

RemoveFromHD :" ~3 else

RemoveFromHd :•' Inst end;

end; (RemoveFromHD)